[Programmer-VB] export ke excell (plizz help)

Fri, 25 Nov 2005 02:34:43 -0800

hi sobat vb saya lgi kesulitan membuat program export ke excel dr access.
untuk export na saya sudah bisa cuma saya mau tambahin buat filter berdasar tanggal yg bertipe text.
 masalah nya ketika dia memeriksa seluruh record pada akhir lalu muncul error
"multiple step generated error,please check each status value"
untuk lebih jelas na saya lampirkan source nya

Dim DB As Connection
Dim RS As Recordset
Dim RS_COUNT As New ADODB.Recordset
Dim RStgl As New ADODB.Recordset
Dim EXAP As New Excel.Application
Dim eX_book As New Excel.Workbook
Dim i, j As Integer
Sub opttgl()
If RS.State = adStateOpen Then
    RS.Close
    End If
Dim sqltgl As String
sqltgl = "select * from billing where tanggal like '" & Me.txttgl.Text & "%' "
RS.Open sqltgl
RS.Requery
End Sub
Private Sub Command1_Click()
   
    Set EXAP = CreateObject("Excel.Application")
    Set eX_book = EXAP.Workbooks.Add
   
    EXAP.Cells(1, 1) = DataGrid1.Columns(0).Caption
    EXAP.Cells(1, 2) = DataGrid1.Columns(1).Caption
    EXAP.Cells(1, 3) = DataGrid1.Columns(2).Caption
    EXAP.Cells(1, 4) = DataGrid1.Columns(3).Caption
    EXAP.Cells(1, 5) = DataGrid1.Columns(4).Caption
    EXAP.Cells(1, 6) = DataGrid1.Columns(5).Caption
    EXAP.Cells(1, 7) = DataGrid1.Columns(6).Caption
    EXAP.Cells(1, 8) = DataGrid1.Columns(7).Caption
    EXAP.Cells(1, 9) = DataGrid1.Columns(8).Caption
   
  
   RS.MoveFirst
        For i = 2 To RS_COUNT.Fields(0).Value + 1
            For j = 1 To RS.Fields.Count
                EXAP.Cells(i, j) = RS.Fields(j - 1).Value
            Next
           
            RS.MoveNext
           
        Next
        EXAP.Visible = True
   
End Sub

Private Sub Form_Load()
  Set DB = New Connection
Set RS = New Recordset

Dim path As String
path = App.path & "\XXX"
DB.Open "provider=microsoft.jet.oledb.4.0;data source=" & path & ";jet oledb:database password=*XXX"
         
      RS.CursorLocation = adUseClient
      RS.Open "SELECT * FROM billing ", DB, adOpenStatic, adLockOptimistic
      RS_COUNT.Open "SELECT COUNT(*) FROM billing ", DB, adOpenDynamic, adLockOptimistic
  
      Set Me.DataGrid1.DataSource = RS
     
     
End Sub

Private Sub txttgl_Change()
If Me.chktgl.Value = 0 Then
MsgBox "check dlu bodoh", vbCritical
Else
Call opttgl
End If
End Sub

Yahoo! Music Unlimited - Access over 1 million songs. Try it free.

Untuk keluar dari millis ini, kirim email kosong ke:
[EMAIL PROTECTED]


YAHOO! GROUPS LINKS



Kirim email ke