tonykhanh1818 nói:
cám ơn các bác đả có ý kiến hay,để mình nói rỏ lại yêu cầu của mình nha
Ví dụ: mình viết xong một trương trinh quan lý kế toán cho một doanh nghiệp nhỏ,khi bàn giao xong ,chạy ổn định không có vấn đề gì hết thì chủ doanh nghiệp nói là họ chưa có máy in để in các báo cáo( như báo cáo thuế GTGT cho chi cục thuế chẳng hạng),vậy vấn đề rắc rối là mình không thể đem cả trương trình đến nhờ một dịch vụ in mướn nào để in được,vì nhủ thế có nhiều vấn dể bị ăn cắp bản quyền chẳng hạn,chủa kể khi chép vào máy người ta thì chương trình đơ ra không chịu chay nửa,công việc của ta là làm sao xuất trực tiếp báo cáo thuế ấy từ chương trình của mình ra thẳng Excel hoặc World củng được để khi nhò người ta in ra báo cáo cho dể dàng hơn,khỏi sợ bị ăn cắp bản quyền v.v.v.
Nhờ các bác giúp mình nha,cám ơn nhiều lắm đó
Chào bạn
Gửi bạn đoạn mã xuất dữ liệu từ SQL sang Excel viết bằng Access
Private Sub Show_Click()
On Error GoTo MyErr
Dim cn As New ADODB.Connection
Dim cm As New ADODB.Command
Dim Rst As New ADODB.Recordset
Dim xl As New excel.Application
Dim wb As New excel.Workbook
Dim ws As New excel.Worksheet
Dim DestPath As String, SourcePath As String
Dim Sql As String, EndDate As String, CustID As String, BranchID As String, Acct As String
Dim FormatNbr As String
Dim xRow As Integer, BegRow As Integer
Dim xCol As Integer, sRow1 As Integer, sRow2 As Integer, xCounter As Integer
Dim xClassID As String, xClassName As String
Dim NewClass As Boolean
FormatNbr = "* #,##0.00;[Red] (#,##0.00);_( ""-""_);_(@_)"
' KiÓm tra ngµy th¸ng
If Nz(Me.EndDate, "") = "" Then
MsgBox "B¹n ph¶i nhËp c¸c mèc thêi gian", vbInformation, "Th«ng b¸o..."
Me.EndDate.SetFocus
Exit Sub
End If
If Not IsDate(Me.EndDate) Then
MsgBox "D÷ liÖu kh«ng ®óng kiÓu", vbInformation, "Th«ng b¸o..."
Me.EndDate.SetFocus
Exit Sub
End If
Screen.MousePointer = 11
EndDate = SqlValue(Me.EndDate)
Acct = SqlValue(Nz(Me.Acct, ""))
CustID = SqlValue(Nz(Me.CustID, ""))
BranchID = SqlValue(Nz(Me.BranchID, ""))
cn.ConnectionTimeout = 0
cn.CommandTimeout = 0
cm.CommandTimeout = 0
Set cn = CurrentProject.Connection
cm.ActiveConnection = cn
cm.CommandType = adCmdText
Sql = "Select ClassID, ClassName, CustID, Custname, DrAmt, CurrentAmt, OvdAmt01, OvdAmt02, OvdAmt03, OvdAmt04, OvdAmt05, OvdAmt06, ApplyingAmt "
Sql = Sql & "From xfw_AgedAr01 ("
Sql = Sql & EndDate & ", " & Acct & ", " & CustID & ", " & BranchID & ")"
Sql = Sql & " Order by ClassID, CustID"
cm.CommandText = Sql
Set Rst = cm.Execute
'Rst.Open Sql, cn, adOpenDynamic, adLockOptimistic
If Rst.RecordCount = 0 Then
Screen.MousePointer = 0
MsgBox "Kh«ng cã d÷ liÖu !", vbInformation, "Th«ng b¸o ..."
Rst.Close
Exit Sub
End If
'T¹o File Exel
SourcePath = CurrentProject.Path + "\Templates\" + "AgedAR01.xls"
DestPath = CurrentProject.Path + "\Export" & "\AgedAR01_" + Format(Now(), "yyyymmdd_hhnnss") + ".xls"
If Dir(SourcePath) <> "" Then
Call FileCopy(SourcePath, DestPath)
Else
Screen.MousePointer = 0
MsgBox "Kh«ng t×m thÊy File " & SourcePath, vbInformation, "Th«ng b¸o..."
Exit Sub
End If
Set wb = xl.Workbooks.Open(DestPath)
Set ws = wb.Worksheets(1)
xl.Visible = True
'Cac tieu de
xRow = 1
ws.Cells(xRow, 1) = GetCompanyName() 'Tªn c«ng ty
ws.Cells(xRow, 1).Font.Bold = True
If Trim(Nz(Me.Acct, "")) <> "" Then
xRow = xRow + 1
ws.Cells(xRow, 4) = "Tµi kho¶n: " & Trim(Nz(Me.Acct, "")) & "-" & Trim(Nz(Me.AcctDescr, ""))
ws.Cells(xRow, 4).Font.Bold = True
Else
ws.Rows(xRow + 1).EntireRow.Delete
End If
xRow = xRow + 1
ws.Cells(xRow, 4) = "Ngµy: " & Format(Me.EndDate, "dd/mm/yyyy")
ws.Cells(xRow, 4).Font.Bold = True
xRow = xRow + 3
sRow1 = 0
BegRow = xRow
xCounter = 1
Rst.MoveFirst
xClassID = ""
xClassName = Rst!ClassName
Do While Not Rst.EOF
If xClassID <> Rst!ClassId Then
NewClass = True
sRow2 = xRow
Else
NewClass = False
End If
xClassID = Rst!ClassId
xClassName = Rst!ClassName
'Ghi dong Sub ToTal
If sRow2 > sRow1 And sRow1 > 0 Then
For xCol = 4 To 12
ws.Cells(sRow1, xCol).FormulaR1C1 = "=Sum(R" & Trim(CStr(sRow1 + 1)) & "C" & Trim(CStr(xCol)) _
& ":R" & Trim(CStr(sRow2 - 1)) & "C" & Trim(CStr(xCol)) & ")"
Next
ws.Range("A" & sRow1 & ":L" & sRow1).NumberFormat = FormatNbr
ws.Range("A" & sRow1 & ":L" & sRow1).Font.ColorIndex = 5
ws.Range("A" & sRow1 & ":L" & sRow1).Font.Bold = True
End If
If Not NewClass Then
ws.Cells(xRow, 1) = xCounter
ws.Cells(xRow, 2) = Rst!CustID
ws.Cells(xRow, 3) = Rst!CustName
ws.Cells(xRow, 4) = Rst!DrAmt
ws.Cells(xRow, 4).NumberFormat = FormatNbr
ws.Cells(xRow, 5) = Rst!CurrentAmt
ws.Cells(xRow, 5).NumberFormat = FormatNbr
ws.Cells(xRow, 6) = Rst!OvdAmt01
ws.Cells(xRow, 6).NumberFormat = FormatNbr
ws.Cells(xRow, 7) = Rst!OvdAmt02
ws.Cells(xRow, 7).NumberFormat = FormatNbr
ws.Cells(xRow, 8) = Rst!OvdAmt03
ws.Cells(xRow, 8).NumberFormat = FormatNbr
ws.Cells(xRow, 9) = Rst!OvdAmt04
ws.Cells(xRow, 9).NumberFormat = FormatNbr
ws.Cells(xRow, 10) = Rst!OvdAmt05
ws.Cells(xRow, 10).NumberFormat = FormatNbr
ws.Cells(xRow, 11) = Rst!OvdAmt06
ws.Cells(xRow, 11).NumberFormat = FormatNbr
ws.Cells(xRow, 12) = Rst!ApplyingAmt
ws.Cells(xRow, 12).NumberFormat = FormatNbr
xCounter = xCounter + 1
Rst.MoveNext
Else
sRow1 = xRow
ws.Cells(xRow, 2) = Rst!ClassId
ws.Cells(xRow, 2).Font.ColorIndex = 5
ws.Cells(xRow, 2).Font.Bold = True
ws.Cells(xRow, 3) = Rst!ClassName
ws.Cells(xRow, 3).Font.ColorIndex = 5
ws.Cells(xRow, 3).Font.Bold = True
End If
xRow = xRow + 1
ws.Range("D" & xRow).Select
Loop
Rst.Close
sRow2 = xRow
'Ghi dong Sub ToTal
For xCol = 4 To 12
ws.Cells(sRow1, xCol).FormulaR1C1 = "=Sum(R" & Trim(CStr(sRow1 + 1)) & "C" & Trim(CStr(xCol)) _
& ":R" & Trim(CStr(sRow2 - 1)) & "C" & Trim(CStr(xCol)) & ")"
Next
ws.Range("A" & sRow1 & ":L" & sRow1).NumberFormat = FormatNbr
ws.Range("A" & sRow1 & ":L" & sRow1).Font.ColorIndex = 5
ws.Range("A" & sRow1 & ":L" & sRow1).Font.Bold = True
'Ghi dong Grand Total
ws.Cells(xRow, 3) = "Tæng céng"
ws.Cells(xRow, 3).HorizontalAlignment = xlCenter
For xCol = 4 To 12
ws.Cells(xRow, xCol).FormulaR1C1 = "=SumIf(R" & Trim(CStr(BegRow)) & "C" & Trim(CStr(1)) _
& ":R" & Trim(CStr(sRow2 - 1)) & "C" & Trim(CStr(1)) _
& "," & """""" & "," _
& "R" & Trim(CStr(BegRow)) & "C" & Trim(CStr(xCol)) _
& ":R" & Trim(CStr(sRow2 - 1)) & "C" & Trim(CStr(xCol))
Next
ws.Range("A" & xRow & ":L" & xRow).NumberFormat = FormatNbr
ws.Range("A" & xRow & ":L" & xRow).Font.Bold = True
xRow = xRow - 1
ws.Range("A" & xRow & ":L" & xRow).Borders(xlEdgeBottom).LineStyle = xlContinuous
ws.Range("A" & xRow & ":L" & xRow).Borders(xlEdgeBottom).Weight = xlThin
ws.Range("A" & xRow & ":L" & xRow).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
xRow = xRow + 1
ws.Range("A" & xRow & ":K" & xRow).Borders(xlEdgeBottom).LineStyle = xlContinuous
ws.Range("A" & xRow & ":K" & xRow).Borders(xlEdgeBottom).Weight = xlThin
ws.Range("A" & xRow & ":K" & xRow).Borders(xlEdgeBottom).ColorIndex = xlAutomatic
ws.Rows(Trim(CStr(xRow + 1)) & ":65536").ClearContents
ws.Rows(Trim(CStr(xRow + 1)) & ":65536").ClearFormats
wb.save
Set ws = Nothing
Set wb = Nothing
Set xl = Nothing
Screen.MousePointer = 0
MsgBox "§· kÕt xuÊt thµnh c«ng !", vbInformation, "Th«ng b¸o..."
Exit Sub
MyErr:
Select Case Err.Number
Case 70
Screen.MousePointer = 0
MsgBox "B¹n ®ang më File Source Templates Excel" & Chr(13) & "Vui lßng ®ãng File l¹i !", vbInformation, "Th«ng b¸o"
Case 1004, 50290
Resume
Case Is <> 0
Screen.MousePointer = 0
MsgBox Err.Description, vbInformation, "Show_Click:" & Err.Number
End Select
End Sub
Thân.