Home > Visual Basic > Membuat laporan dalam format Ms Excel

Membuat laporan dalam format Ms Excel

Ada banyak cara untuk membuat laporan di visual basic, tiga diantaranya :
1. Data Report
2. Active Report
3. Crystal Report

Alternatif lain adalah dengan memanfaatkan program Ms Excel, untuk contoh disini saya akan menampilkan data siswa (no, nis, nama, nilai). Untuk menyederhanakan program saya akan menyimpan datanya di variabel array.

Copy paste kode berikut di modul :

Option Explicit

Public Const xlSolid                As Long = 1
Public Const xlContinuous           As Long = 1

Public Const xlCenter               As Long = -4108
Public Const xlBottom               As Long = -4107
Public Const xlRight                As Long = -4152
Public Const xlLeft                 As Long = -4131
Public Const xlTop                  As Long = -4160

Public Enum EFormatType
    General = 1
    Number = 2
    Money = 3
    Accounting = 4
    Percentage = 5
    Scientific = 6
    Text = 7
    ShortDate = 8
    LongDate = 9
    ShortTime = 10
    LongTime = 11
    NumberWithoutDecimal = 12
End Enum

Private Function GetFormatType(ByVal v_bytFormatType As EFormatType) As String
    On Error Resume Next

    'Add the left header
    Select Case v_bytFormatType
        Case General: GetFormatType = "General" 'Format as general
        Case Number: GetFormatType = "0.00" 'Format as number
        Case NumberWithoutDecimal: GetFormatType = "0"
        Case Money: GetFormatType = "#,##0" 'Format as currency
        Case Accounting: GetFormatType = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" 'Format as accounting
        Case ShortDate: GetFormatType = "dd/mm/yy" 'Format as short date
        Case LongDate: GetFormatType = "dd mmm yyyy" 'Format as long date
        Case ShortTime: GetFormatType = "h:mm" 'Format as short time
        Case ShortTime: GetFormatType = "h:mm:ss AM/PM" 'Format as long time
        Case Percentage: GetFormatType = "0.00%" 'Format as percentage
        Case Scientific: GetFormatType = "0.00E+00" 'Format as scientific
        Case Text: GetFormatType = "@" 'Format as text
       Case Else: GetFormatType = "General" 'Default to general
    End Select
End Function

Public Sub formatCell(ByVal objWSheet As Object, _
                       ByVal baris1 As Long, ByVal kolom1 As Integer, _
                       ByVal baris2 As Long, ByVal kolom2 As Integer, _
                       ByVal fontBold As Boolean, ByVal fontSize As Integer, _
                       ByVal mergeCell As Boolean, _
                       ByVal HorizontalAlgn As Long, ByVal VerticalAlgn As Long, _
                       Optional ByVal setColorHeader As Boolean = False, _
                       Optional ByVal setBorder As Boolean = False, _
                       Optional ByVal setColumnType As EFormatType = Text)

    On Error GoTo errHandle

    With objWSheet
        .Range(.cells(baris1, kolom1), .cells(baris2, kolom2)).Font.Bold = fontBold
        .Range(.cells(baris1, kolom1), .cells(baris2, kolom2)).Font.Size = fontSize
        .Range(.cells(baris1, kolom1), .cells(baris2, kolom2)).MergeCells = mergeCell
        .Range(.cells(baris1, kolom1), .cells(baris2, kolom2)).cells.HorizontalAlignment = HorizontalAlgn
        .Range(.cells(baris1, kolom1), .cells(baris2, kolom2)).cells.VerticalAlignment = VerticalAlgn

        If setColorHeader = True Then
            .Range(.cells(baris1, kolom1), .cells(baris2, kolom2)).Interior.ColorIndex = 15
            .Range(.cells(baris1, kolom1), .cells(baris2, kolom2)).Interior.Pattern = xlSolid
        End If

        If setBorder = True Then .Range(.cells(baris1, kolom1), .cells(baris2, kolom2)).Borders.LineStyle = xlContinuous

        .Range(.cells(baris1, kolom1), .cells(baris2, kolom2)).NumberFormat = GetFormatType(setColumnType)

    End With

    Exit Sub
errHandle:
    Exit Sub
End Sub

Public Function convertColRowToAreaRef(ByVal objWSheet As Object, ByVal columnFrom As Long, ByVal rowFrom As Long, ByVal columnTo As Long, ByVal rowTo As Long) As String
    Dim tmp As String

    With objWSheet
        tmp = .Range(.Cells(rowFrom, columnFrom), .Cells(rowTo, columnTo)).Address
    End With

    tmp = Replace(tmp, "$", "")

    convertColRowToAreaRef = tmp
End Function

sedangkan untuk form kodenya seperti berikut :

Private Sub cmdLapDataSiswaToXLS_Click()
    Dim objExcel    As Object
    Dim objWBook    As Object
    Dim objWSheet   As Object

    Dim areaRef     As String
    Dim nis(5)      As String
    Dim nama(5)     As String
    Dim nilai(5)    As Integer

    Dim startRow    As Long
    Dim kolom       As Long
    Dim initRow     As Long
    Dim i           As Long

    nis(0) = "9941224167": nama(0) = "Abdul Fatahurrahman": nilai(0) = 75
    nis(1) = "9928712140": nama(1) = "Desy Efriani": nilai(1) = 60
    nis(2) = "9930340568": nama(2) = "Durotun Nafisah": nilai(2) = 70
    nis(3) = "9941224212": nama(3) = "Bayu Pranoto": nilai(3) = 85
    nis(4) = "9941224276": nama(4) = "Hofiruh Sotul'aini": nilai(4) = 95
    nis(5) = "9928712137": nama(5) = "Indra Gunawan": nilai(5) = 100

    '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
        Call formatCell(objWSheet, 1, 1, 1, 4, True, 10, True, xlCenter, xlCenter)
        .cells(1, 1) = "DAFTAR NILAI SISWA"

        initRow = 3

        Call formatCell(objWSheet, initRow, 1, initRow, 4, True, 8, False, xlCenter, xlCenter, True, True)

        kolom = 1
        .cells(initRow, kolom) = "No."
        .Columns(kolom).ColumnWidth = 3.86

        kolom = 2
        .cells(initRow, kolom) = "N I S"
        .Columns(kolom).ColumnWidth = 12.86

        kolom = 3
        .cells(initRow, kolom) = "Nama"
        .Columns(kolom).ColumnWidth = 25.86

        kolom = 4
        .cells(initRow, kolom) = "Nilai"
        .Columns(kolom).ColumnWidth = 6.86

        Call formatCell(objWSheet, initRow + 1, 1, initRow + UBound(nis) + 1, 1, False, 8, False, xlCenter, xlCenter, False, True, General) 'NO
        Call formatCell(objWSheet, initRow + 1, 2, initRow + UBound(nis) + 1, 3, False, 8, False, xlLeft, xlCenter, False, True)   'NIS DAN NAMA
        Call formatCell(objWSheet, initRow + 1, 4, initRow + UBound(nis) + 1, 4, False, 8, False, xlRight, xlCenter, False, True, General)  'NILAI
        For i = LBound(nis) To UBound(nis)
            If startRow = 0 Then startRow = initRow + i + 1

            .cells(initRow + i + 1, 1) = (i + 1)
            .cells(initRow + i + 1, 2) = nis(i)
            .cells(initRow + i + 1, 3) = nama(i)
            .cells(initRow + i + 1, 4) = nilai(i)
        Next i

        areaRef = convertColRowToAreaRef(objWSheet, 4, startRow, 4, initRow + i)

        Call formatCell(objWSheet, initRow + i + 1, 3, initRow + i + 2, 3, False, 8, False, xlRight, xlCenter, True, True)  'Jumlah dan rata-rata
        .cells(initRow + i + 1, 3) = "Jumlah"
        .cells(initRow + i + 2, 3) = "Rata-rata"

        Call formatCell(objWSheet, initRow + i + 1, 4, initRow + i + 1, 4, False, 8, False, xlRight, xlCenter, True, True, General) 'Jumlah
        .cells(initRow + i + 1, 4) = "=SUM(" & areaRef & ")"

        Call formatCell(objWSheet, initRow + i + 2, 4, initRow + i + 2, 4, False, 8, False, xlRight, xlCenter, True, True, Number) 'Rata-rata
        .cells(initRow + i + 2, 4) = "=AVERAGE(" & areaRef & ")"
    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
End Sub

Contoh hasil dari kode diatas :

dan jangan lupa ikuti artikel lanjutannya.

Selamat mencoba :)

About these ads
  1. April 20, 2010 at 5:23 pm | #1

    HATUR NUHUN KANG,,,

  2. April 20, 2010 at 10:17 pm | #2

    sama2x om

  3. July 2, 2010 at 4:24 am | #3

    salam kenal,
    terima kasih atas informasi mengenai laporan format excel ini, tapi ada yang saya ingin tanyakan mas.
    kalau kita ingin hasil akhir tampilannya langsung print preview di excel, bisa atau tidak y ?
    mohon pencerahannya…
    terima kasih….

    • July 2, 2010 at 6:38 am | #4

      Salam kenal juga

      Setelah perintah objExcel.Visible = True, tambahkan kode berikut :

      objExcel.ActiveWorkbook.PrintPreview
      

      Selamat mencoba :)

  4. April 19, 2011 at 6:01 pm | #5

    makasih bnyak bang… sangat bermanfaat sekali ilmu nya…

  5. ardiest
    June 22, 2011 at 4:40 am | #7

    Terima Kasih banyak untuk sharing ilmu nya. bener2 bermanfaat buat saya ;).
    btw, klo format nya ada yg merged di row N col cell tertentu bisa ngga ya?

    • June 22, 2011 at 5:48 am | #8

      Ya jelas bisa om, coba di cek lagi method formatCell diatas kan ada parameter mergeCell

      • ardiest
        June 22, 2011 at 6:50 am | #9

        hihihi…iya, ternyata ada. sekali terima kasih banyak ya buat sharing nya.

        • December 28, 2011 at 3:57 pm | #10

          Sama2x om, ternyata komen yg satu ini sampe kelewatan jawabnya :D

  6. ardiest
    December 28, 2011 at 3:33 pm | #11

    Ada yg mau saya tanyakan lagi nih bang. klo ingin memasukan obyek gambar ke excel caranya bagaimana ya?
    Terima kasih sebelum nya.

    • December 28, 2011 at 4:00 pm | #12

      Coba tambahkan 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 pic As Object
          
          Set pic = objWBook.Worksheets(worksheet).Pictures.Insert(imageName)
          pic.Top = objWBook.Worksheets(worksheet).Range(kolom & iRow).Top - minTop
          pic.Left = objWBook.Worksheets(worksheet).Range(kolom & iRow).Left + plusLeft
          pic.width = width
          pic.height = height
          
          Set pic = Nothing
      End Sub
      

      Trus cara pakenya cukup seperti ini :

      Call addImage(objWBook, "folder\gambar", "C", 10, 85, 95.25, -13, 70)
      

      Untuk kolom “C” dan angka disesuaikan.

      • ardiest
        January 2, 2012 at 6:02 pm | #13

        Terima Kasih banyak bang admin. saya coba dulu prosedur nya :).

  7. March 16, 2012 at 1:45 pm | #14

    saya mau tanya om, kalau misalnya data yang di ambil dari datagrid bisa gk??? sy bingung buat perulangannya. . soalnya yang di atas kn nama2 dan data yang lainnya sudah ditentukan di scriftnya. .

    • March 17, 2012 at 8:36 am | #15

      Datagrid ya, klo yg ini sy udah lama enggak make, udah tobat :D

      Jadi belum bisa bantu :(

  8. ajied
    April 11, 2012 at 2:22 pm | #16

    Datagrid dah tobat ya om,.. klo dari database mysql datanya gmn om…..

    • April 11, 2012 at 2:28 pm | #17

      Ya query biasa trus dilooping, untuk komponennya menggunakan listview, ms flexgrid atau vsflexgrid

  9. November 4, 2012 at 10:01 pm | #18

    Salam kenal gan.. Saya sudah coba scriptnya dengan database Access dan berjalan lancar. Tapi ketika saya coba dengan database MySQL kenapa pengaturan format (ukuran font, warna background, dll) jadi berantakan…?

  10. budi
    January 18, 2013 at 5:11 pm | #19

    salam kenal mas…
    mas mau tanya bagaimana caranya untuk export laporan menggunakan active report ke pdf atau excel… trims…

    • January 19, 2013 at 4:09 pm | #20

      Pertama tambahkan dulu referensi ActiveReport PDF Export Filter, untuk keperluan report PDFnya sendiri tidak perlu mendesain khusus reportnya, jadi cukup menggunakan desain report yg sudah ada, berikut kodenya :

      Private Sub cmdExportToPDF_Click()
          Dim pdf         As ActiveReportsPDFExport.ARExportPDF
          Dim fileName    As String
          
          fileName = App.Path & "\myActiveReport.pdf"
          ' TODO : tambahkan pengecekan file PDF hasil exportnya klo sudah ada dihapus dulu
          
          Load myActiveReport ' nama report, tinggal disesuaikan
          With myActiveReport
              .DataControl1.ConnectionString = "string koneksi"
              .DataControl1.Source = "perintah select"
      
              .Run
              
              Set pdf = New ActiveReportsPDFExport.ARExportPDF
              pdf.fileName = fileName
              
              .Export pdf
              
              Set pdf = Nothing
              
          End With
          Unload myActiveReport
      End Sub
      

      Selamat mencoba :)

  11. ardi
    June 27, 2013 at 2:58 pm | #21

    mas kalo mau cetak ke excel yg sudah disiapkan templatenya gimana yah? dan sekaligus mencetak di setiap sheet yg berbeda

  12. July 17, 2013 at 9:50 am | #23

    mas mksdnya “Copy paste kode berikut di modul”

    itu mksdnya di source code datareport nya??
    maaf pertanyaanya kaya gn, sy baru bljr vb jd sk ga ngerti klo penjelasanya ga detail.
    makasih sblmnya :D

    • July 17, 2013 at 1:46 pm | #24

      Enggak om, ini enggak pake datareport jadi langsung di copas di kode VBnya

  13. sudik
    October 20, 2013 at 10:02 am | #25

    mas, kalo datanya diambilkan dari database gimana caranya?

    • October 20, 2013 at 3:25 pm | #26

      Ya sama aj, yg penting om bisa melakukan hal-hal berikut :
      1. SELECT dari sebuah tabel kemudian menyimpan ke dalam objek Recordset
      2. Mengekstrak data dari objek Recordset menggunakan perulangan

      • sudik
        October 21, 2013 at 9:05 am | #27

        mas, saya masih bingung maklum newbie niih..saya kan ada tabel “BARANG” dengan field kode_barang,nama_barang,jenis_barang,jumlah_stock,dan harga_barang.yang ingin saya tampilkan ke excel cuma nama_barang,jenis_barang dan harga_barang dan di excelnya grouping berdasarkan jenis_barang.Mohon pencerahannya maaf ngerepotin mas :D

  14. Junaidin My
    January 8, 2014 at 2:27 pm | #28

    saya belum faham mas, di mana tempat Copy paste kode berikut di modul, mohon di jelaskan sedikit lagi…..

  15. Junaidin My
    January 8, 2014 at 2:45 pm | #29

    mohon info lebih detile

    • January 8, 2014 at 3:04 pm | #30

      Nah ini sy kasih gambarnya

      Tinggal copy kodenya sesuai petunjuk di form atau modul, kemudian untuk form tambahkan sebuah tombol kemudian ganti namanya menjadi cmdLapDataSiswaToXLS

  16. Anwar
    February 26, 2014 at 4:04 pm | #31

    ma’af mas mau numpang tanya.. Tolong di jawab ya penting banget nih..
    gemana cara nya kalau data nya saya ambil dari data yang saya tampilkan di lisview..

    • March 4, 2014 at 9:50 am | #32

      Nah sy balik tanya, udah bisa belum melakukan perulangan untuk membaca item ListViewnya ?

  1. No trackbacks yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: