• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Module Xuất Excel từ Recordset

Các Module, Class, UserControl và thư viện OCX, DLL hỗ trợ cho Visual Basic
boy1234
Guru
Guru
Bài viết: 448
Ngày tham gia: T.Hai 13/10/2008 3:12 pm
Đến từ: Dĩ An - Bình Dương
Been thanked: 32 time

Module Xuất Excel từ Recordset

Gửi bàigửi bởi boy1234 » CN 20/11/2011 8:40 pm

Tên: Module xuất ra file Excel từ Recordset
Loại: Module
Ngôn ngữ lập trình: VB6
Tác giả: boy1234
Chức năng: Xuất ra tập file Excel

Mài mò sáng giờ được cái Module này. Không biết forum có chưa(mình viết hơi dài dòng :D). Hy vọng được học hỏi thêm

Module nhận 3 tham số:
- Recordset
- Tên đường dẫn\tên tập tin file Excel(.xls)
- Tên tiêu đề

Note: add References Microsoft Excel 12.0 Object Library

  1.  
  2.  
  3. Public ExcelApp As New Excel.Application
  4.  
  5. Public Sub XuatExcel(ByVal rs As Recordset, ByVal Pathfilename As String, ByVal Title As String)
  6.     Dim i As Long, j As Long, k As Long, iSocot As Long, iSodong As Long, iWidth As Long
  7.     Dim Temp As String
  8.     Dim aSplit() As String
  9.    
  10.     On Error Resume Next
  11.     Screen.MousePointer = vbHourglass
  12.     aSplit = Split(Pathfilename, "\")
  13.     Temp = aSplit(UBound(aSplit))
  14.    
  15.     ExcelApp.DisplayAlerts = False 'khong cho show thong bao Save
  16.    '-----------------------------------------------------------'
  17.    If Dir(Pathfilename) <> "" Then Kill Pathfilename 'neu co thi xoa file
  18.    '-----------------------------------------------------------'
  19.    ExcelApp.Workbooks.Add
  20.     ExcelApp.Workbooks(Workbooks.Count).SaveAs Pathfilename
  21.     Call ExcelApp.Workbooks(Temp).Worksheets.Add
  22.    
  23.     iSocot = rs.Fields.Count
  24.     iSodong = rs.RecordCount
  25.    
  26.     ExcelApp.ActiveSheet.Name = Temp
  27.     With ExcelApp.Workbooks(Temp).Worksheets(Temp)
  28.         Cells(1, 1) = Title
  29.         Cells(1, 1).Font.Size = 15
  30.         Cells(1, 1).Font.Bold = True
  31.         Cells(1, 1).HorizontalAlignment = xlCenter
  32.         Range(Cells(1, 1), Cells(1, iSocot + 1)).MergeCells = True
  33.         Cells(3, 1) = "No"
  34.         Range(Cells(3, 1), Cells(3, iSocot + 1)).Font.Size = 11
  35.         Range(Cells(3, 1), Cells(3, iSocot + 1)).Font.Bold = True
  36.         Range(Cells(3, 1), Cells(3, iSocot + 1)).HorizontalAlignment = xlCenter
  37.         For j = 1 To iSocot
  38.             Cells(3, j + 1) = rs.Fields(j - 1).Name
  39.             'dong khung Title     '
  40.            Range(Cells(3, j), Cells(3, j + 1)).Borders(xlEdgeLeft).LineStyle = xlContinuous
  41.             If j <> iSocot Then
  42.                 Range(Cells(3, j), Cells(3, j + 1)).Borders(xlEdgeRight).LineStyle = xlContinuous
  43.             End If
  44.             Range(Cells(3, j), Cells(3, j + 1)).Borders(xlEdgeTop).LineStyle = xlContinuous
  45.         Next j
  46.        
  47.         For i = 1 To iSodong
  48.             Cells(3 + i, 1) = i
  49.             For k = 1 To iSocot
  50.                 Cells(3 + i, k + 1) = rs.Fields(k - 1)
  51.                
  52.                 'dong khung cac cells  '
  53.                Range(Cells(3 + i, k), Cells(3 + i, k + 1)).Borders(xlEdgeLeft).LineStyle = xlContinuous
  54.                 If k <> iSocot Then
  55.                     Range(Cells(3 + i, k), Cells(3 + i, k + 1)).Borders(xlEdgeRight).LineStyle = xlContinuous
  56.                 End If
  57.                 Range(Cells(3 + i, k), Cells(3 + i, k + 1)).Borders(xlEdgeTop).LineStyle = xlContinuous
  58.                 If i <> (iSodong - 1) Then
  59.                     Range(Cells(3 + i, k), Cells(3 + i, k + 1)).Borders(xlEdgeBottom).LineStyle = xlContinuous
  60.                 End If
  61.                 Cells(3 + i, k + 1).ColumnWidth = Len(rs.Fields(k - 1)) + 10
  62.             Next k
  63.             rs.MoveNext
  64.         Next i
  65.         Range(Cells(3, iSocot + 1), Cells(iSodong + 3, iSocot + 1)).Borders(xlEdgeRight).LineStyle = xlContinuous
  66.     End With
  67.    
  68.     ExcelApp.ActiveWorkbook.Save
  69.     Screen.MousePointer = vbDefault
  70.     ExcelApp.Visible = True 'cho show Excel
  71.    
  72. End Sub
  73.  
  74.  
Tập tin đính kèm
ProjectXuatExcel.rar
(28.28 KiB) Đã tải 1069 lần


Dạo này nghiện honda SS50

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Re: Module Xuất Excel từ Recordset

Gửi bàigửi bởi truongphu » CN 20/11/2011 10:50 pm

boy1234 đã viết:Mài mò sáng giờ được cái Module này. Không biết forum có chưa(mình viết hơi dài dòng ). Hy vọng được học hỏi thêm


Hay lắm Boy!
Mò mẫm một hồi cũng thạo VBA/Excel
Tham khảo thêm:
viewtopic.php?f=30&t=16124
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

QuocKien85
Bài viết: 7
Ngày tham gia: T.Năm 17/11/2011 2:25 pm

Re: Module Xuất Excel từ Recordset

Gửi bàigửi bởi QuocKien85 » T.Ba 29/11/2011 4:44 pm

Bạn ơi cho mình hỏi mình muốn sử dụng lệnh MouseMove để khi di chuyển con trỏ tới thì hình nó hiện to ra khi di chuột ra thì nó nhỏ lại với lệnh m viết thế này có đúng không? coi dúp m với
"" Private Sub Cmdm7_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Cmdm1.Picture = LoadPicture(App.Path & "\Images\logoff1.bmp") """
nó có 2 hình 1 thì hiện bên ngoài nút lệnh còn 1 thì ẩn khi chuột rê tới mới hiện thị.

thanhbinhkgg
Thành viên chính thức
Thành viên chính thức
Bài viết: 23
Ngày tham gia: T.Ba 01/07/2008 10:07 pm
Has thanked: 1 time
Been thanked: 5 time

Re: Export_ADO2XLS không References Microsoft Excel 12.0 Obj

Gửi bàigửi bởi thanhbinhkgg » CN 04/03/2012 5:33 pm

Cách của Tôi không phải add References Microsoft Excel 12.0 Object Library
Yêu cầu: Add CommonDialog -- Để cho phép chọn tên file và thu mục cần save

------------------------------------------------
Nếu không Add CommonDialog thì bỏ đi phần chọn tên file qua CommonDialog là ok
------------------------------------------------

Mã: Chọn hết

Public Sub Export_ADO2XLS(adoRecordset As ADODB.Recordset, tenfile As String, CommonDialog As CommonDialog)
    'Author: Hoàng Thanh Bình
   
    Dim lstrFileName As String
    Dim lintFileNum As Integer
    Dim X, i, intCol, intRow As Integer

    lintFileNum = FreeFile

    If adoRecordset.EOF = True Then
        Exit Sub
    End If
    With CommonDialog
        .CancelError = False  ' Generate Error number cdlCancel if user click Cancel
        .filename = tenfile & "_" & Format(Date, "YYYY-MM")
        .InitDir = App.Path  ' Initial (i.e. default ) Folder
        .Filter = "Microsoft Excel (*.xls) | *.xls"
        .FilterIndex = 2  ' Select ""Executables (*.exe) | *.exe" as default
        .DialogTitle = "Nhap ten tap tin de luu"
        .ShowSave   ' Lauch the Open Dialog
    End With

    If CommonDialog.filename <> "" Then
        lstrFileName = CommonDialog.filename & CommonDialog.DefaultExt
        If VerifyFile(lstrFileName) Then
            Randomize
            lstrFileName = Replace(CommonDialog.filename & CommonDialog.DefaultExt, ".xls", "_#" & Trim$(str(Int(99 * Rnd + 1))) & ".xls")
        End If

        ' open the log file
        Open lstrFileName For Output As lintFileNum
        Print #lintFileNum, "<table cellspacing=3 cellpadding=5 border=1 rules=all cols=6 frame=below><tr valign='top'></tr>"
        Print #lintFileNum, "<tr>"
        For i = 0 To adoRecordset.Fields.Count - 1
            Print #lintFileNum, "<td><font face=verdana,arial,helvetica SIZE=2><b>" & adoRecordset.Fields(i).name & "</b></font></td>"
        Next
        Print #lintFileNum, "</tr>"
        Print #lintFileNum, "<tr>"

        Do Until adoRecordset.EOF
            For intCol = 0 To adoRecordset.Fields.Count - 1
                Print #lintFileNum, "<td>" & IIf(InStr(adoRecordset.Fields(intCol), "/") > 0, "'" & adoRecordset.Fields(intCol), adoRecordset.Fields(intCol)) & "</td>"
            Next
            Print #lintFileNum, "</tr>"
            Print #lintFileNum, "<tr>"

            adoRecordset.MoveNext
        Loop
        Print #lintFileNum, "</Table>"
        Close lintFileNum
    Else
        MsgBox "LOI: ban chua chon ten tap tin can xuat."
    End If
End Sub

Public Function VerifyFile(f_name As String) As Boolean

    On Error GoTo OKerr

    Open f_name For Input As #1
    Close #1
OKerr:

    If err Then
        VerifyFile = False
    Else
        VerifyFile = True
    End If

    Close #1
End Function

PS: Có 1 cách đơn giản hơn là xuất ra file dạng CSV. Mỗi trường cách nhau bàng dấu , (phẩy)

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Re: Module Xuất Excel từ Recordset

Gửi bàigửi bởi truongphu » CN 04/03/2012 8:33 pm

Chủ nhật, "sần sần".
Dặn lòng đã "xỉn" không đi đâu...
kẹt là url clbvb trong tầm tay!!


thanhbinhkgg đã viết:Cách của Tôi không phải add References Microsoft Excel 12.0 Object Library


Hoan nghênh bạn đóng góp cho forum!
Ta có quyền không add References Microsoft Excel 12.0 Object Library
và như vậy thì không lợi dụng tính năng của "nó" thôi!

thanhbinhkgg đã viết:PS: Có 1 cách đơn giản hơn là xuất ra file dạng CSV. Mỗi trường cách nhau bàng dấu , (phẩy)


Đúng rồi, bạn có quyền xuất file csv (mà mặc định, dù csv là file text nhưng excel vẫn mở...

thanhbinhkgg đã viết:lstrFileName = Replace(CommonDialog.filename & CommonDialog.DefaultExt, ".xls", "_#" & Trim$(str(Int(99 * Rnd + 1))) & ".xls")
        End If
        ' open the log file
        Open lstrFileName For Output As lintFileNum

Tôi chưa text code bạn, nhưng "cái nầy" lạ à nha...
Lệnh Open của VB6 là mở text file
mà lstrFileName có đuôi là xls!!
(mỗi đuôi có định dạng riêng, không phải muốn tạo file bất kỳ với lệnh Open [classic] Vb6 là được)

thanhbinhkgg đã viết:        Print #lintFileNum, "<table cellspacing=3 cellpadding=5 border=1 rules=all cols=6 frame=below><tr valign='top'></tr>"
        Print #lintFileNum, "<tr>"


Bạn đang dùng lệnh Print, mà sao thấy 'tùm lum" code NGOÀI VB6?, hình như đang hỗn hợp asp thì phải?
Có lẽ bạn muốn tạo file htm? khó hiểu nhỉ?

thanhbinhkgg đã viết:VerifyFile = True

hàm VerifyFille ở đâu ra thế?...

Nói tóm lại, Rất hoan nghênh bạn đã trao đổi
Mong bạn gởi thên Project để minh họa ý tưởng của bạn
Mỗi ý kiến đóng góp của bất kỳ ai đều quý...

Thân @-)
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

thanhbinhkgg
Thành viên chính thức
Thành viên chính thức
Bài viết: 23
Ngày tham gia: T.Ba 01/07/2008 10:07 pm
Has thanked: 1 time
Been thanked: 5 time

Re: Module Xuất Excel từ Recordset

Gửi bàigửi bởi thanhbinhkgg » T.Hai 05/03/2012 4:29 pm

Không phải add References Microsoft Excel 12.0 Object Library sẽ có cái hay của nó. Em cũng vừa phải phát triển thêm 1 cái SQL2DBF không lệ thuộc các thư viện của Foxpro :)


hàm VerifyFille ở đâu ra thế?...
<== em add trong code rồi mà Bác


Tôi chưa text code bạn, nhưng "cái nầy" lạ à nha...
Lệnh Open của VB6 là mở text file
mà lstrFileName có đuôi là xls!!
(mỗi đuôi có định dạng riêng, không phải muốn tạo file bất kỳ với lệnh Open [classic] Vb6 là được)


Bác dùng thử Project sẽ rõ. Trong project em viết vội nên kết nối foxpro để xuất sang xls.
Trong code em cũng để sẵn phần kết nối SQL Server để bác test
Tập tin đính kèm
ExportSQLorDBFtoXLS.zip
Export SQL/DBF to XLS
(3.89 KiB) Đã tải 474 lần


Quay về “[VB] Module, Class, UserControl, OCX”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.0 khách