• Xuất report ra excel
  • 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 LongrecCount As LongcolCount As LonglngR As LongAs 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 1 To colCount
            Sht
    .Cells(recCount 2i).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 StringsWorkbookPath As String
        
        sSourceName 
    "qryXuatExcel"
        sWorkbookPath CurrentProject.Path "\Xuat_report_excel.xltx"
        
        Call DataToExcel
    (sSourceNamesWorkbookPath)
        
    End Sub

    Function DataToExcel(strSourceName As StringOptional strWorkbookPath As StringOptional 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 LongrecCount As LongcolCount As LongAs 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 firstRow2).Value "T" ChrW(7893) & "ng c" ChrW(7897) & "ng:"
        Sht.Cells(recCount firstRow2).HorizontalAlignment = -4108
        Sht
    .Cells(recCount firstRow2).Font.Bold True
        
    For 3 To colCount 1
            Sht
    .Cells(recCount firstRowi).FormulaR1C1 "=SUM(R[-" recCount "]C:R[-1]C)"
            Sht.Cells(recCount firstRowi).Font.Bold True
        Next i

        
    For firstRow To recCount firstRow 1
            Sht
    .Cells(i20).FormulaR1C1 "=SUM(RC[-17]:RC[-1])"
            Sht.Cells(i24).FormulaR1C1 "=RC[-4]-RC[-3]"
            Sht.Cells(i25).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 StringsWorkbookPath As String
        
        sSourceName 
    "qryXuatExcel"
        sWorkbookPath CurrentProject.Path "\Xuat_report_excel.xltx"
        
        Call DataToExcel
    (sSourceNamesWorkbookPath)
        
    End Sub

    Function DataToExcel(strSourceName As StringOptional strWorkbookPath As StringOptional 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 LongrecCount As LongcolCount As LongAs 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 firstRow2).Value "T" ChrW(7893) & "ng c" ChrW(7897) & "ng:"
        Sht.Cells(recCount firstRow2).HorizontalAlignment = -4108
        Sht
    .Cells(recCount firstRow2).Font.Bold True
        
    For 3 To colCount 1
            Sht
    .Cells(recCount firstRowi).FormulaR1C1 "=SUM(R[-" recCount "]C:R[-1]C)"
            Sht.Cells(recCount firstRowi).Font.Bold True
        Next i

        
    For firstRow To recCount firstRow 1
            Sht
    .Cells(i20).FormulaR1C1 "=SUM(RC[-17]:RC[-1])"
            Sht.Cells(i24).FormulaR1C1 "=RC[-4]-RC[-3]"
            Sht.Cells(i25).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.