klo koneksi ke access banyak ko tinggal googling aja ke paman google
ato klo mau juga di planetsourcecode banyak bgt
neh salah satu contoh klo mau convert ke excel n banyak lagi contoh sourcecoe
buat konvert ke excel laennya
intinya mas sdickyn79 koneksi dl ke access nya trus lakukan suatu query
nah query tadi yang tar di panggil buat convert ke access
misal di button_click:
Private Sub Button1_Click(Index As Integer)
penting = "select id, nama, nilai from data"
ngekspor
End Sub
Private Sub ngekspor()
On Error GoTo ErrHandler
Set rs0 = New ADODB.Recordset
rs0.Open penting, oconn, adOpenStatic, adLockReadOnly
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets(1) '("Sheet1")
xlApp.Visible = True
xlApp.UserControl = True
fldCount = rs0.Fields.Count
For iCol = 1 To fldCount
xlWs.Cells(1, iCol).Value = rs0.Fields(iCol - 1).Name
Next
If Val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") _
- 1)) > 8 Then
xlWs.Cells(2, 1).CopyFromRecordset rs0
Else
recArray = rs0.GetRows
recCount = UBound(recArray, 2) + 1 '+ 1 karena array berbasis 0
For iCol = 0 To fldCount - 1
For iRow = 0 To recCount - 1
If IsDate(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = _
Format(recArray(iCol, iRow))
ElseIf IsArray(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = "Array Field"
End If
Next iRow 'record berikutnya
Next iCol ' field berikutnya
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
TransposeDim(recArray)
End If
xlApp.Selection.CurrentRegion.Columns.AutoFit
xlApp.Selection.CurrentRegion.Rows.AutoFit
'rs0.Close
'oconn.Close
'Set rs0 = Nothing
'Set oconn = Nothing
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
Exit Sub
ErrHandler:
If rs0.State = adStateOpen Then
rs0.Close
Set rs0 = Nothing
End If
MsgBox Err.Description
End Sub
Function TransposeDim(v As Variant) As Variant
' Fungsi untuk metranspose array berbasi 0 (v)
Dim x As Long, Y As Long, Xupper As Long, Yupper As Long
Dim tempArray As Variant
Xupper = UBound(v, 2)
Yupper = UBound(v, 1)
ReDim tempArray(Xupper, Yupper)
For x = 0 To Xupper
For Y = 0 To Yupper
tempArray(x, Y) = v(Y, x)
Next Y
Next x
TransposeDim = tempArray
End Function
sdickyn79 <[EMAIL PROTECTED]> wrote: Dear VB-er
semua.
minta tutorial formulir isian dengan koneksi ke ms. access sekalian
konversi ke excelnya.
commandbutton
save record
find record
add record
delete record
ole untuk photo
convert to excel
