Jumat, 12 November 2010

Fungsi untuk mengekspor data dari variabel recordset ke excel

cara memanggil fungsi letakan fungsi ini pada event objek pada visual basic 6.0:

sub obj_event()
    ExportToExcel rs
end sub

Public Sub ExportToExcel(rs As Recordset)
  Dim xApp As New Excel.Application
    Dim xWB As New Excel.Workbook
    Dim xWS As New Excel.Worksheet
    n = 1
    k = 1
    Set xWB = xApp.Workbooks.Add
    xApp.Visible = True
    xApp.UserControl = True
    Set xWS = xWB.Worksheets(n)
    sh = fld_name(rs.Fields(1).Name)
    xWS.Select
    xWS.Name = sh
    xWS.Cells(1, k).Value = Replace(rs.Fields(0).Name, "_", " ")
    For i = 1 To rs.Fields.Count - 1
    sh_next = fld_name(rs.Fields(i).Name)
    If sh = sh_next Then
        k = k + 1
        xWS.Cells(1, k).Value = Replace(rs.Fields(i).Name, "_", " ")
    Else
        k = 1
        n = n + 1
        If n > 3 Then
            xWB.Worksheets.Add after:=xWB.Worksheets(n - 1)
        End If
        Set xWS = xWB.Worksheets(n)
        sh = fld_name(rs.Fields(i).Name)
        xWS.Select
        xWS.Name = sh

        xWS.Cells(1, k).Value = Replace(rs.Fields(i).Name, "_", " ")
    End If
'rs.MoveNext
Next i
    Set xApp = Nothing
    Set xWB = Nothing
    Set xWS = Nothing
End Sub

Tidak ada komentar:

Posting Komentar