Dim con As ADODB.Connection
Dim rec As ADODB.Recordset
Dim connectString As String
Dim objExcel As Object
Dim objTemp As Object
Public Sub excel(rec As ADODB.Recordset)
Dim indexbaris As Integer
Dim indexcolom As Integer
Dim jmlrecord As Integer
Dim jmlfield As Integer
Dim totalbaris As Variant
Dim excelVersion As Integer
totalbaris = rec.GetRows()
jmlrecord = UBound(totalbaris, 2) + 1
jmlfield = UBound(totalbaris, 1) + 1
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
Set objTemp = objExcel
excelVersion = Val(objExcel.Application.Version)
If (excelVersion >= 8) Then
Set objExcel = objExcel.ActiveSheet
End If
indexbaris = 1
indexcolom = 1
For indexcolom = 1 To jmlfield
With objExcel.Cells(indexbaris, indexcolom)
.Value = rec.Fields(indexcolom - 1).Name
With .Font
.Name = "Tahoma"
.Bold = True
.Size = 8
End With
End With
Next
rec.Close
Set rec = Nothing
With objExcel
For indexbaris = 2 To jmlrecord + 1
For indexcolom = 1 To jmlfield
.Cells(indexbaris, indexcolom).Value = totalbaris(indexcolom - 1, indexbaris - 2)
Next
Next
End With
objExcel.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
End Sub
Private Sub Form_Activate()
Dim SqlString As String
Set con = New ADODB.Connection
Set rec = New ADODB.Recordset
connectString = "Provider=Microsoft.Jet.OLEDB.3.51;" _
& "Data Source=C:\Program Files\Microsoft Visual Studio\VB98\BIBLIO.MDB"
SqlString = "SELECT * FROM Publishers where PubID <= 50" con.Open connectString rec.CursorLocation = adUseClient rec.Open SqlString, con End Sub Private Sub Command1_Click() Call excel(rec) End Sub
Tidak ada komentar:
Posting Komentar