Home > Visual Basic > Membuat laporan dalam format Ms Excel plus ada gambarnya

Membuat laporan dalam format Ms Excel plus ada gambarnya

April 28, 2010

Artikel ini ditulis berdasarkan beberapa artikel favorit di blog ini😀, yaitu artikel INI dan ITU.

Inti pembahasan artikel kali ini adalah menampilkan gambar yang disimpan di database ke Ms Excel.

Untuk contoh disini kita akan menampilkan data siswa (nis, nama, alamat plus fotonya).

Ada banyak cara untuk menampilkan gambar di Ms Excel salah satunya dengan menggunakan prosedur berikut :

Private Sub addImage(ByVal objWBook As Object, ByVal imageName As String, ByVal kolom As String, ByVal iRow As Long, _
                    ByVal width As Double, ByVal height As Double, _
                    Optional minTop As Integer = 10, Optional plusLeft As Integer = 16, Optional worksheet As Long = 1)

    Dim objPict As Object

    Set objPict = objWBook.Worksheets(worksheet).Pictures.Insert(imageName)
    With objPict
        .Top = objWBook.Worksheets(worksheet).Range(kolom & iRow).Top - minTop
        .Left = objWBook.Worksheets(worksheet).Range(kolom & iRow).Left + plusLeft
        .width = width
        .height = height
    End With
    Set objPict = Nothing
End Sub

Kemudian untuk mengambil data berupa gambar dari database, prosedur yang digunakan adalah sebagai berikut :

Public Function getImageFromDB(ByVal query As String) As String
    Dim sFile           As String

    On Error GoTo errHandle

    Set rsImage = New ADODB.Recordset
    rsImage.Open query, conn, adOpenForwardOnly, adLockReadOnly
    If Not rsImage.EOF Then
        If Not IsNull(rsImage(0).Value) Then
            nHandle = FreeFile

            sFile = App.Path & "\output.bin"
            If fileExists(sFile) Then Kill sFile
            DoEvents

            Open sFile For Binary Access Write As nHandle

            lsize = rsImage(0).ActualSize
            iChunks = lsize \ CHUNK_SIZE
            nFragmentOffset = lsize Mod CHUNK_SIZE

            varChunk() = rsImage(0).GetChunk(nFragmentOffset)
            Put nHandle, , varChunk()
            For i = 1 To iChunks
                 ReDim varChunk(CHUNK_SIZE) As Byte

                 varChunk() = rsImage(0).GetChunk(CHUNK_SIZE)
                 Put nHandle, , varChunk()
                 DoEvents
            Next
            Close nHandle

            getImageFromDB = sFile
        End If
    End If
    Call closeRecordset(rsImage)

    Exit Function
errHandle:
    getImageFromDB = ""
End Function

Prosedur diatas merupakan revisi dari prosedur yang ada di artikel sebelumnya, perbedaannya hanya terletak pada return value (nilai kembaliannya) jika pada artikel sebelumnya return valuenya bertipe IPictureDisp sedang revisi prosedur pada artikel ini bertipe String.

Terakhir untuk mengekspor ke Ms Excel sekaligus contoh penggunaan ke dua prosedur diatas adalah sebagai berikut :

Private Sub cmdEkspor_Click()
    Dim rs          As ADODB.Recordset

    Dim objExcel    As Object
    Dim objWBook    As Object
    Dim objWSheet   As Object

    Dim initRow     As Long
    Dim strSql      As String

    On Error GoTo errHandle

    Screen.MousePointer = vbHourglass
    DoEvents

    'Create the Excel object
    Set objExcel = CreateObject("Excel.application") 'bikin object

    'Create the workbook
    Set objWBook = objExcel.Workbooks.Add

    Set objWSheet = objWBook.Worksheets(1)
    With objWSheet
        initRow = 5

        strSql = "SELECT * FROM siswa"
        Set rs = conn.Execute(strSql)
        If Not rs.EOF Then
            Do While Not rs.EOF
                .cells(initRow, 5) = "NIS"
                .cells(initRow, 6) = ": " & rs("nis").Value

                .cells(initRow + 1, 5) = "Nama"
                .cells(initRow + 1, 6) = ": " & rs("nama").Value

                .cells(initRow + 2, 5) = "Alamat"
                .cells(initRow + 2, 6) = ": " & rs("alamat").Value

                strSql = "SELECT foto FROM siswa WHERE nis = '" & rs("nis").Value & "'"
                Call addImage(objWBook, getImageFromDB(strSql), "C", initRow, 45, 51, 12, 48)

                initRow = initRow + 5
                rs.MoveNext
            Loop
        End If
        Call closeRecordset(rs)
    End With

    objExcel.Visible = True

    If Not objWSheet Is Nothing Then Set objWSheet = Nothing
    If Not objWBook Is Nothing Then Set objWBook = Nothing
    If Not objExcel Is Nothing Then Set objExcel = Nothing

    Screen.MousePointer = vbDefault

    Exit Sub

errHandle:
    If Not objWSheet Is Nothing Then Set objWSheet = Nothing
    If Not objWBook Is Nothing Then Set objWBook = Nothing
    If Not objExcel Is Nothing Then Set objExcel = Nothing
End Sub

Contoh hasil ekspor

Selamat mencoba🙂

  1. adhyconedaime
    April 30, 2010 at 2:52 pm

    Boz, mw tanya..
    coding di atas berlaku untuk Datagrid ato MSFlexgrid? terima kasih..

  2. April 30, 2010 at 10:07 pm

    adhyconedaime :

    Boz, mw tanya..
    coding di atas berlaku untuk Datagrid ato MSFlexgrid? terima kasih..

    Yg jelas bisa tinggal di custom aja, format tabel sendirikan berupa baris dan kolom sama seperti datagrid atw msflexgrid.

  3. Tuin
    July 12, 2010 at 8:20 am

    Bos..mau tanya kalo pengen hasilnya seperti di atas tanpa menggunakan makro bisa ga? misalkan menggunakan v-lookup gitu bos..???maklum saya belum bisa mainin makro.
    thanks before

    • July 12, 2010 at 8:45 am

      Makro itu bukannya di VBA om, walaupun bahasanya mirip dg VB dan klo sy tangkep dari pertanyaan om kayaxnya om bukan dari latar belakang programming ya? Klo iya mungkin bisa mengacu ke link ini om, soalnya Excel sy juga enggak terlalu advanced banget😀

  4. Tuin
    July 14, 2010 at 9:28 am

    Betul bos…saya bukan dari programming, makanya saya bingung bangat nih wat bikin seperti yang saya mau tapi denngan rumus standard dari excel…bisa bantu ga bos..???thanks before

    • July 15, 2010 at 3:31 am

      Sama boz ilmu sy juga belum nyampe situ, jadi belum bisa bantu😀

  5. April 13, 2011 at 12:17 am

    thanks gan, saya unduh ya contoh projectnya ..🙂

    • April 13, 2011 at 1:41 am

      Oke om

  6. pudyasto
    May 10, 2011 at 2:46 am

    Mas… mau tanya nech, cara exsport dari database microsoft sql server 2000 ke excel gimana ya? masih ga mudeng nech….. trimz

    • May 10, 2011 at 3:06 am

      Sample di atas udah dicoba belum ?
      Klo belum coba jangan langsung bilang enggak mudeng

      Perbedaan mengakses databse Ms Access dan Ms SQL Server itu secara umum hanya di koneksi awal aja, jadi tinggal ganti aja koneksi sample diatas ke Ms SQL Server trus sesuaikan juga tabel yang diekspor.

  7. Firman
    July 17, 2012 at 7:44 pm

    Gan Kalo Nampilin Gambar Di Microsoft Excel Seperti Di Kop Surat ntu Gmana Gan
    Soalnya Laporan Yang saya bwat dengan VB menggunakan Excel . . . apakah pake App Path juga pada Macronya, Kalo Iya Contohnya Gmana Gan . . .

    TQ

    • July 21, 2012 at 11:31 am

      Loh bukannya contoh diatas udah bisa nampilin gambar, jadi tinggal diatur aja posisi gambar di bagian kop suratnya.

  8. Firman
    July 23, 2012 at 11:50 am

    Gan kalau yang diatas ntu kan gambarnya Dari database trus ditampilin ke Excel,
    kalau bukan dari database gimana gan, apa caranya sama..?

    • July 23, 2012 at 12:30 pm

      Sama, tinggal sebutih lokasi dan nama filenya.

  9. August 16, 2012 at 9:45 am

    ngoding terus gaaaaannnn….

    • August 16, 2012 at 10:18 am

      Namanya juga coding4ever om😀

      • Karyono
        February 25, 2013 at 8:57 pm

        Mas, kalo menampilkan fotonya pada active report gmn yah…..

        • February 26, 2013 at 10:17 am

          Coba cek kesini om.

          • Karyono
            February 27, 2013 at 9:13 pm

            Agar gambar/foto menyesuaikan dengan bingkai / ukuran yang kita sesuaikan sendiri gmn?? Misal ukuran 2×3, 3×4, 4×6.

            • February 28, 2013 at 11:37 am

              Objek imagenya mempunyai property SizeMode, set nilainya menjadi Stretch

              • Karyono
                February 28, 2013 at 5:28 pm

                Thank You……………………..

                • February 28, 2013 at 7:10 pm

                  U’re welcome🙂

  10. jems huik
    November 2, 2013 at 11:07 am

    master bole minta filenya…!!!

    • November 2, 2013 at 11:50 am

      Bukannya di atas sudah sy kasih link downloadnya ?

      • November 5, 2013 at 5:08 am

        Yuph, senang bisa membantu🙂

  11. jems huik
    November 2, 2013 at 2:34 pm

    sudah saya download master….!! thanks…!!

  1. April 16, 2014 at 9:13 am
Comments are closed.
%d bloggers like this: