Giúp xuất báo cáo ra Excel và dữ nguyên định dạng (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

huyhoang_mmyeht

Thành viên hoạt động
Tham gia
5/5/09
Bài viết
142
Được thích
12
Chào các bạn hiện mình muốn nhờ các bạn giúp mình xuất báo cáo ra excel và tự động thiếp lập định dạng.
- ở file Access khi dữ liệu đưa vào thì ta mở form1 và nhấn nút thì dữ liệu chuyễn qua excel và thiếp lập định dạng theo (kho,nhóm,mã vật tư) như file excel đính kèm). hiện tại mình đang làm thủ công chuyển qua để gửi báo cáo đi nên rất mất công nên lên đây các cao thủ giúp mình!

Thanks!
 

File đính kèm

Lần chỉnh sửa cuối:
Chào các bạn hiện mình muốn nhờ các bạn giúp mình xuất báo cáo ra excel và tự động thiếp lập định dạng.
- ở file Access khi dữ liệu đưa vào thì ta mở form1 và nhấn nút thì dữ liệu chuyễn qua excel và thiếp lập định dạng theo (kho,nhóm,mã vật tư) như file excel đính kèm). hiện tại mình đang làm thủ công chuyển qua để gửi báo cáo đi nên rất mất công nên lên đây các cao thủ giúp mình!

Thanks!

Bạn dùng code sau nhé:

Mã:
Private Sub Command3_Click()
Dim db As DAO.Database, rs As DAO.Recordset, mySQL As String
Dim oApp As New Excel.Application, oBook As Excel.Workbook, oSheet As Excel.Worksheet
    Set oBook = oApp.Workbooks.Open(CurrentProject.Path & "\Baocao.xlt")
    mySQL = "SELECT STT, Group, ItemKey, ItemName, Unit, Begin, Import, TotalOut, EVA, HTD, Other, Ending " & _
            "FROM (SELECT (select count([table].Group) + 1 " & _
            "from [table] as tb where tb.[Itemname]< [table].[Itemname] and tb.Group  = [table].Group " & _
            ") AS STT, table.ItemKey, table.ItemName, table.Unit, table.Begin, table.Import, [EVA]+[HTD]+[Other] " & _
            "AS TotalOut, table.EVA, table.HTD, table.Other, table.Ending, table.Group " & _
            "FROM [Table] ORDER BY table.Group) " & _
            "ORDER BY Group, STT;"
    Set oSheet = oBook.Sheets("CEMENT")
    Set db = CurrentDb
    Set rs = db.OpenRecordset(mySQL, dbOpenSnapshot)
    With oSheet
        .Range("A7").CopyFromRecordset rs
        .Range("a6").CurrentRegion.Borders.LineStyle = xlContinuous
        .Range("A6:M" & .Range("A65000").End(xlUp).Row).Subtotal GroupBy:=2, _
                        Function:=xlSum, TotalList:=Array(6, 7, 8, 9, 10, 11, 12), SummaryBelowData:=False
    End With
    MsgBox "Da xuat xong du lieu sang Excel", vbExclamation, "HLMT"
    rs.Close
    oApp.Visible = True
    db.Close

End Sub

Giải nén và mở file Access, chạy code.
 

File đính kèm

Mình dùng Excel và Access 2010 nó báo lỗi như file đính kèm bạn ơi!
 

File đính kèm

  • Untitled.jpg
    Untitled.jpg
    20 KB · Đọc: 68
Mình dùng Excel và Access 2010 nó báo lỗi như file đính kèm bạn ơi!

Còn cả 1 "rừng" lỗi nữa chứ không phải chỉ lỗi ấy thôi đâu
Bạn sửa code thành vầy nhé:
Mã:
Private Sub Command3_Click()
  Dim db As DAO.Database, rs As DAO.Recordset, mySQL As String
  [COLOR=#ff0000]Dim oApp As Object, oBook As Object, oSheet As Object[/COLOR]
  [COLOR=#ff0000]Set oApp = CreateObject("Excel.Application")[/COLOR]
  Set oBook = oApp.Workbooks.Open(CurrentProject.Path & "\Baocao.xlt")
  mySQL = "SELECT STT, Group, ItemKey, ItemName, Unit, Begin, Import, TotalOut, EVA, HTD, Other, Ending " & _
            "FROM (SELECT (select count([table].Group) + 1 " & _
            "from [table] as tb where tb.[Itemname]< [table].[Itemname] and tb.Group  = [table].Group " & _
            ") AS STT, table.ItemKey, table.ItemName, table.Unit, table.Begin, table.Import, [EVA]+[HTD]+[Other] " & _
            "AS TotalOut, table.EVA, table.HTD, table.Other, table.Ending, table.Group " & _
            "FROM [Table] ORDER BY table.Group) " & _
            "ORDER BY Group, STT;"
  Set oSheet = oBook.Sheets("CEMENT")
  Set db = CurrentDb
  Set rs = db.OpenRecordset(mySQL, dbOpenSnapshot)
  With oSheet
    .Range("A7").CopyFromRecordset rs
    .Range("a6").CurrentRegion.Borders.[COLOR=#ff0000]LineStyle = 1[/COLOR]
    [COLOR=#ff0000].Range("M6", .Range("A65000").End(3)).Subtotal 2, 9, Array(6, 7, 8, 9, 10, 11, 12), , , False[/COLOR]
  End With
  MsgBox "Da xuat xong du lieu sang Excel", vbExclamation, "HLMT"
  rs.Close
  oApp.Visible = True
  db.Close
End Sub
Những chổ màu đỏ là những chổ đã phải sửa lại (và BẮT BUỘC phải sửa như thế nếu không muốn mất công vào Tools\References check mục Microsoft Excel...)
 
Lần chỉnh sửa cuối:
bạn ơi cái này chưa thỏa mãn như tiêu đề mình muốn.
nhưng cũng cảm ơn sự nhiệt tình của bạn!
thứ nhất mình muối group buy theo kho, sau đó mới đến nhóm, và tiếp đến là mã vật tư
trong bài của bạn mới có goup được theo nhóm còn kho thì chưa có!
bạn xem lại mình với nhé!
 
Web KT

Bài viết mới nhất

Back
Top Bottom