Re: [Programmer-VB] transfer excel

Tue, 10 Jan 2006 19:40:28 -0800

Mau transfer dari rekening mana dulu mas jos...
hehehe
 
saya coba bantu ya...
 
Private Sub export_excel()
   
    Dim xlApp As Object
    Dim xlWb As Object
    Dim xlWs As Object
   
    Dim recArray As Variant
   
    Dim strDB As String
    Dim fldCount As Integer
    Dim recCount As Long
    Dim iCol As Integer
    Dim iRow As Integer
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
 
rs.Open sql, dbbph, adOpenStatic, adLockOptimistic
rs.MoveLast
rs.MoveFirst
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets("Sheet1")
  
  
    xlApp.Visible = True
    xlApp.UserControl = True
    
    fldCount = rs.Fields.Count
    For iCol = 1 To fldCount
        xlWs.cells(1, iCol).Value = rs.Fields(iCol - 1).Name
    Next
        

    If Val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then

   
        xlWs.cells(2, 1).CopyFromRecordset rs
       
    Else
    
        recArray = rs.GetRows(rs.RecordCount)
        recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array
       
        For iCol = 0 To fldCount - 1
            For iRow = 0 To recCount - 1
                ' Take care of Date fields
                If IsDate(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = Format(recArray(iCol, iRow))
                ' Take care of OLE object fields or array fields
                ElseIf IsArray(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = "Array Field"
                End If
            Next iRow 'next record
        Next iCol 'next field

        xlWs.cells(2, 1).Resize(recCount, fldCount).Value = _
            TransposeDim(recArray)
    End If

    xlApp.Selection.CurrentRegion.Columns.AutoFit
    xlApp.Selection.CurrentRegion.Rows.AutoFit
    
    Set xlWs = Nothing
    Set xlWb = Nothing
    Set xlApp = Nothing
End Sub

Kepanjangan ga ya???
mungkin tmen2 yg lain punya yg lebih pendek.....hehehe
 
semoga membantu
 
--aL--
joseph jos <[EMAIL PROTECTED]> wrote:
rekan rekan,mohon bantuannya nih, saya ingin
mentransfer hasil laporan tetapi ditampilkan di excel.
Terima kasih atas bantuannya.

__________________________________________________
Do You Yahoo!?
Tired of spam?  Yahoo! Mail has the best spam protection around
http://mail.yahoo.com

Yahoo! Photos
Got holiday prints? See all the ways to get quality prints in your hands ASAP.

Wahana Programmer Groups Links

<*> Untuk mengunjungi sponsor milis ini, klik link berikut:
    http://wahanaprogrammer.net

<*> Untuk menghubungi owner milis ini, kirim email ke:
    [EMAIL PROTECTED]

<*> Konsultasi pemrogramman bisa chat disini:
    Yahoo! Messenger: wahanaprogrammer


YAHOO! GROUPS LINKS



Kirim email ke