Giúp chuyển báo cáo từ dạng Access sang Excel (2 người xem)

Liên hệ QC

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

nhoc_khun

Thành viên mới
Tham gia
16/12/09
Bài viết
49
Được thích
7
Tôi có file access, nhưng mỗi lần muốn báo cáo tình hình sản xuất cuối tháng phải in ra và chuyển bằng tay, thay vì gửi qua email như các sếp yêu cầu. Tôi đã dùng thử cách chuyển sẵn có trong access nhưng cột thay đổi hết. Vậy bác nào có thể giúp tôi xuất báo cáo từ access sang excel mà không thay đổi định dạng, số liệu. Cảm ơn nhiều.
 

File đính kèm

Lần chỉnh sửa cuối:
cột thay đổi là thay đổi thế nào bạn? nói rõ hơn được không. tôi export có vấn đề gì đâu.
 
Tôi có file access, nhưng mỗi lần muốn báo cáo tình hình sản xuất cuối tháng phải in ra và chuyển bằng tay, thay vì gửi qua email như các sếp yêu cầu. Tôi đã dùng thử cách chuyển sẵn có trong access nhưng cột thay đổi hết. Vậy bác nào có thể giúp tôi xuất báo cáo từ access sang excel mà không thay đổi định dạng, số liệu. Cảm ơn nhiều.

Tạo file excel dạng temp, khi xuất dữ liệu ra ta xuất theo form excel đó, bạn tạo file form excel mẫu + chuyển file access trên sang 2003 rồi gửi lên xem thử nhé.
 
Trước hết tôi cảm ơn các bác đã quan tâm.
Tôi xin gửi file đính kèm là biểu mẫu ở dạng excel (1 sheet là file tôi xuất ra từ access, 1 sheet là file mẫu đã được định dạng sẵn, 1 sheet là tôi copy số liệu từ file xuất ra từ access vào file mẫu và sheet cuối cùng là các mối quan hệ về số liệu giữa các cột trong 2 sheet trước đó) và file access 2003 (chỉ có số liệu của năm 2011). Hy vọng các bác thấy rõ hơn.
 

File đính kèm

Vì tài khoản nhoc_khun của tôi chỉ giới hạn được tải lên có 1.0M (xài còn có 34k) nên tôi phải tạo thêm 1 tài khoản khác để gửi file đính kèm. Mong các bác thông cảm.
Và luôn tiện cho hỏi làm thế nào để có thể không bị giới hạn dung lượng đôi với tài khoản khi gửi đính kèm file.
Cảm ơn.
 
Bạn thử code sau:

Mã:
Private Sub Command31_Click()
On Error Resume Next
Dim db As DAO.Database, rs As DAO.Recordset, mySQL As String, nYear As Long
Dim oApp As New Excel.Application, oBook As Excel.Workbook, oSheet As Excel.Worksheet
nYear = InputBox("Vui long nhap nam can trich loc.", "Nhap nam", Year(Now()))
If nYear = 0 Then Exit Sub

    Set oBook = oApp.Workbooks.Open(CurrentProject.Path & "\Temp.xlt")
    mySQL = "SELECT NMNVOCANH.Ngay, NMNVOCANH.NuocTho, NMNVOCANH.NuocSX, NMNVOCANH.ThatThoat, NMNVOCANH.DienTT, NMNVOCANH.BinhQuan, " & _
                    "NMNVOCANH.M1, NMNVOCANH.M2, NMNVOCANH.M3, NMNVOCANH.M4, NMNVOCANH.M5, NMNVOCANH.P1, NMNVOCANH.P2, NMNVOCANH.P3," & _
                    "NMNVOCANH.P4, NMNVOCANH.P5, NMNVOCANH.P6, NMNVOCANH.P7, NMNVOCANH.P8, NMNVOCANH.Cong, NMNVOCANH.Phen, NMNVOCANH.BQPhen, " & _
                    "NMNVOCANH.Voi, NMNVOCANH.BQVoi, NMNVOCANH.Clo, NMNVOCANH.BQClo " & _
                    "FROM NMNVOCANH " & _
                    "WHERE Year([ngay]) = " & nYear

    Set oSheet = oBook.Sheets("BaoCao")
    Set db = CurrentDb
    Set rs = db.OpenRecordset(mySQL, dbOpenSnapshot)
    
        oSheet.Range("A15").CopyFromRecordset rs
        MsgBox "Da xuat xong du lieu sang Excel", vbExclamation, "Hai Lua Mien Tay"
         
    rs.Close: Set rs = Nothing
    oApp.Visible = True
    db.Close: Set db = Nothing
    
    
End Sub

Về phần định dạng của file Temp bạn tự làm lại nhé.
Lưu ý giải nén và chạy file.
 

File đính kèm

Thêm cột tên khách hàng thì công thức điều kiện lọc đổi lại sao vậy mấy bác, em không đổi được
 
Mình cảm ơn bạn Hai Lúa Miền Tây đã hướng dẫn tận tình về chủ đề trên, nhưng khi mình thử thêm vào 1 điều kiện nữa thì không trích ra được dữ liệu, dù đã làm tới lui nhiều nhưng không làm được. Vậy nhờ bạn Hai Lúa Miền Tây hướng dẫn thêm dùm. các câu lệnh tô màu là mình thêm vào. xin cảm ơn.
-----------------------------------------------------------

Private Sub Command31_Click()
On Error Resume Next
Dim db As DAO.Database, rs As DAO.Recordset, mySQL As String, nYear As Long, sM1 as Long
Dim oApp As New Excel.Application, oBook As Excel.Workbook, oSheet As Excel.Worksheet
nYear = InputBox("Vui long nhap nam can trich loc.", "Nhap nam", Year(Now()))

sM1= InputBox("Vui long nhap nam can trich loc.", "Nhap so vao”)

If nYear = 0 Then Exit Sub

Set oBook = oApp.Workbooks.Open(CurrentProject.Path & "\Temp.xlt")
mySQL = "SELECT NMNVOCANH.Ngay, NMNVOCANH.NuocTho, NMNVOCANH.NuocSX, NMNVOCANH.ThatThoat, NMNVOCANH.DienTT, NMNVOCANH.BinhQuan, " & _
"NMNVOCANH.M1, NMNVOCANH.M2, NMNVOCANH.M3, NMNVOCANH.M4, NMNVOCANH.M5, NMNVOCANH.P1, NMNVOCANH.P2, NMNVOCANH.P3," & _
"NMNVOCANH.P4, NMNVOCANH.P5, NMNVOCANH.P6, NMNVOCANH.P7, NMNVOCANH.P8, NMNVOCANH.Cong, NMNVOCANH.Phen, NMNVOCANH.BQPhen, " & _
"NMNVOCANH.Voi, NMNVOCANH.BQVoi, NMNVOCANH.Clo, NMNVOCANH.BQClo " & _
"FROM NMNVOCANH " & _
"WHERE Year([ngay]) = " & nYear And [M1] = " & sM1"

Set oSheet = oBook.Sheets("BaoCao")
Set db = CurrentDb
Set rs = db.OpenRecordset(mySQL, dbOpenSnapshot)

oSheet.Range("A15").CopyFromRecordset rs
MsgBox "Da xuat xong du lieu sang Excel", vbExclamation, "Hai Lua Mien Tay"

rs.Close: Set rs = Nothing
oApp.Visible = True
db.Close: Set db = Nothing


End Sub
 
Lần chỉnh sửa cuối:
Ngay chổ "WHERE Year([ngay]) = " & nYear & " And year([M1]) = " & sM1



Xin lỗi tôi chưa test, bạn tự test nhé.

Cảm ơn bạn Hai Lúa Miền Tây, mình đã làm được rồi. Mò mẫm làm hổm nay, bí quá đến hôm nay mới hỏi. Chân thành cảm ơn bạn đã nhiệt tình hướng dẫn.
 
Lần chỉnh sửa cuối:
Web KT

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

Back
Top Bottom