-
Xuất report ra excel
tracanhtam > 01-03-21, 11:02 AM
Xin cho tôi hỏi. Tôi có report như sau:
Cột A Côt B ... Tổng theo dòng
20 12 32
30 5 35
10 3 13
Tổng theo cột 60 20 80
Tôi muốn xuất ra excel mà tại cột tổng theo dòng (=sum(A1:B...) và theo cột (sum(A1:A...)) đều có cộng thức trên excel.
Vậy code xuất ra như thế nào, xin cám ơn. -
RE: Xuất report ra excel
ongke0711 > 01-03-21, 12:37 PM
Bạn dùng thuộc tính ActiveCell.FormulaR1C1 của Excel để gán công thức cho nó.
Vì chẳng biết bạn xuất ra Excel với code như thế nào nên chỉ gợi ý thôi.
Đại khái như sau:
Mã PHP:Dim firstRow As Long, recCount As Long, colCount As Long, lngR As Long, i As Integer
firstRow = 1 'Vị trí Cell đầu tiên bạn đổ dữ liệu cho nó'
recCount = rst.RecordCount
lngR = recCount
colCount = rst.Fields.Count
For i = 1 To colCount
Sht.Cells(recCount + 2, i).formulaR1C1 = "=SUM(R[-" & lngR & "]C:R[-1]C)"
Next i -
RE: Xuất report ra excel
tracanhtam > 02-03-21, 11:31 AM
Bạn giúp dùm xuất report trên access ra file excel mà có sẳn công thức được không, xin cám ơn.
Link file :
https://drive.google.com/file/d/1rvWMvnq...sp=sharing -
RE: Xuất report ra excel
ongke0711 > 02-03-21, 12:24 PM
(02-03-21, 11:31 AM)tracanhtam Đã viết: Bạn giúp dùm xuất report trên access ra file excel mà có sẳn công thức được không, xin cám ơn.
Link file :
https://drive.google.com/file/d/1rvWMvnq...sp=sharing
Sao bạn không tính toán số tổng trước rồi xuất dữ liệu kết quả ra Excel luôn, khỏi phải chèn công thức cho nó chậm file Excel (nếu công thức khủng)?
(PS: nhớ chạy Compact & Repair database để giải phóng không gian dữ liệu. File bạn có ~ 500k sau khi compact) -
RE: Xuất report ra excel
ongke0711 > 02-03-21, 04:42 PM
Bạn xem file.
Link: https://www.mediafire.com/file/hhm99qx62...l.rar/file
Code:
Mã PHP:Option Compare Database
Option Explicit
Private Sub cmdXuatExcel_Click()
Dim sSourceName As String, sWorkbookPath As String
sSourceName = "qryXuatExcel"
sWorkbookPath = CurrentProject.Path & "\Xuat_report_excel.xltx"
Call DataToExcel(sSourceName, sWorkbookPath)
End Sub
Function DataToExcel(strSourceName As String, Optional strWorkbookPath As String, Optional strTargetSheetName As String)
Dim rst As DAO.Recordset
Dim excelApp As Object
Dim Wbk As Object
Dim Sht As Object
Dim xlRng As Object
Dim firstRow As Long, recCount As Long, colCount As Long, i As Integer
'Table/Query
Set rst = CurrentDb.OpenRecordset(strSourceName)
'Tao môt phiên lam viec Excel khác.
Set excelApp = CreateObject("Excel.Application")
On Error Resume Next
Set Wbk = excelApp.Workbooks.Open(strWorkbookPath)
Set Sht = Wbk.Worksheets("BaoCao")
excelApp.Visible = True
On Error GoTo ErrorHandler
rst.MoveFirst
Sht.Range("B7").CopyFromRecordset rst
firstRow = 7
recCount = rst.RecordCount
colCount = rst.Fields.Count
Sht.Cells(recCount + firstRow, 2).Value = "T" & ChrW(7893) & "ng c" & ChrW(7897) & "ng:"
Sht.Cells(recCount + firstRow, 2).HorizontalAlignment = -4108
Sht.Cells(recCount + firstRow, 2).Font.Bold = True
For i = 3 To colCount + 1
Sht.Cells(recCount + firstRow, i).FormulaR1C1 = "=SUM(R[-" & recCount & "]C:R[-1]C)"
Sht.Cells(recCount + firstRow, i).Font.Bold = True
Next i
For i = firstRow To recCount + firstRow - 1
Sht.Cells(i, 20).FormulaR1C1 = "=SUM(RC[-17]:RC[-1])"
Sht.Cells(i, 24).FormulaR1C1 = "=RC[-4]-RC[-3]"
Sht.Cells(i, 25).FormulaR1C1 = "=RC[-2]+RC[-1]"
Next i
'Danh STT
For i = 1 To recCount
Sht.Cells(i + firstRow - 1, 1).Value = i
Next i
'Ke border cho bang
Set xlRng = Sht.Range("A7:Y" & recCount + firstRow)
With xlRng
With .Borders
.ColorIndex = -4105 'xlAutomatic
.LineStyle = 1 'xlContinuous
.Weight = 2 'xlThin
End With
End With
'Dinh dang Number
Set xlRng = Sht.Range("C7:Y" & recCount + firstRow)
With xlRng
.NumberFormat = "0"
.HorizontalAlignment = xlRight
End With
'Them Text
Sht.Cells(recCount + firstRow + 2, 20).Value = "M" & ChrW(7929) & " Tho, " & "Ngày " & Day(Date) & " Tháng " & Month(Date) & " N" & ChrW(259) & "m " & Year(Date)
Sht.Cells(recCount + firstRow + 2, 20).HorizontalAlignment = -4108
Sht.Cells(recCount + firstRow + 3, 20).Value = "T" & ChrW(7893) & " Tr" & ChrW(432) & ChrW(7903) & "ng"
Sht.Cells(recCount + firstRow + 3, 20).Font.Bold = True
Sht.Cells(recCount + firstRow + 3, 20).HorizontalAlignment = -4108
Sht.Cells(1, 1).Select
rst.Close
Set rst = Nothing
Exit Function
ErrorHandler:
MsgBox Err.Number & vbNewLine & Err.Description, vbExclamation
End Function -
RE: Xuất report ra excel
tracanhtam > 04-03-21, 12:45 PM
(02-03-21, 04:42 PM)ongke0711 Đã viết: Bạn xem file.
Link: https://www.mediafire.com/file/hhm99qx62...l.rar/file
Code:
Mã PHP:Option Compare Database
Option Explicit
Private Sub cmdXuatExcel_Click()
Dim sSourceName As String, sWorkbookPath As String
sSourceName = "qryXuatExcel"
sWorkbookPath = CurrentProject.Path & "\Xuat_report_excel.xltx"
Call DataToExcel(sSourceName, sWorkbookPath)
End Sub
Function DataToExcel(strSourceName As String, Optional strWorkbookPath As String, Optional strTargetSheetName As String)
Dim rst As DAO.Recordset
Dim excelApp As Object
Dim Wbk As Object
Dim Sht As Object
Dim xlRng As Object
Dim firstRow As Long, recCount As Long, colCount As Long, i As Integer
'Table/Query
Set rst = CurrentDb.OpenRecordset(strSourceName)
'Tao môt phiên lam viec Excel khác.
Set excelApp = CreateObject("Excel.Application")
On Error Resume Next
Set Wbk = excelApp.Workbooks.Open(strWorkbookPath)
Set Sht = Wbk.Worksheets("BaoCao")
excelApp.Visible = True
On Error GoTo ErrorHandler
rst.MoveFirst
Sht.Range("B7").CopyFromRecordset rst
firstRow = 7
recCount = rst.RecordCount
colCount = rst.Fields.Count
Sht.Cells(recCount + firstRow, 2).Value = "T" & ChrW(7893) & "ng c" & ChrW(7897) & "ng:"
Sht.Cells(recCount + firstRow, 2).HorizontalAlignment = -4108
Sht.Cells(recCount + firstRow, 2).Font.Bold = True
For i = 3 To colCount + 1
Sht.Cells(recCount + firstRow, i).FormulaR1C1 = "=SUM(R[-" & recCount & "]C:R[-1]C)"
Sht.Cells(recCount + firstRow, i).Font.Bold = True
Next i
For i = firstRow To recCount + firstRow - 1
Sht.Cells(i, 20).FormulaR1C1 = "=SUM(RC[-17]:RC[-1])"
Sht.Cells(i, 24).FormulaR1C1 = "=RC[-4]-RC[-3]"
Sht.Cells(i, 25).FormulaR1C1 = "=RC[-2]+RC[-1]"
Next i
'Danh STT
For i = 1 To recCount
Sht.Cells(i + firstRow - 1, 1).Value = i
Next i
'Ke border cho bang
Set xlRng = Sht.Range("A7:Y" & recCount + firstRow)
With xlRng
With .Borders
.ColorIndex = -4105 'xlAutomatic
.LineStyle = 1 'xlContinuous
.Weight = 2 'xlThin
End With
End With
'Dinh dang Number
Set xlRng = Sht.Range("C7:Y" & recCount + firstRow)
With xlRng
.NumberFormat = "0"
.HorizontalAlignment = xlRight
End With
'Them Text
Sht.Cells(recCount + firstRow + 2, 20).Value = "M" & ChrW(7929) & " Tho, " & "Ngày " & Day(Date) & " Tháng " & Month(Date) & " N" & ChrW(259) & "m " & Year(Date)
Sht.Cells(recCount + firstRow + 2, 20).HorizontalAlignment = -4108
Sht.Cells(recCount + firstRow + 3, 20).Value = "T" & ChrW(7893) & " Tr" & ChrW(432) & ChrW(7903) & "ng"
Sht.Cells(recCount + firstRow + 3, 20).Font.Bold = True
Sht.Cells(recCount + firstRow + 3, 20).HorizontalAlignment = -4108
Sht.Cells(1, 1).Select
rst.Close
Set rst = Nothing
Exit Function
ErrorHandler:
MsgBox Err.Number & vbNewLine & Err.Description, vbExclamation
End Function
Cám ơn bạn nhiều lắm.