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