Skip to main content

Form Dialog Cetak Buatan Sendiri ini Lebih Canggih Daripada Buatan Access

Judul posting kali ini cukup menantang dan provokatif. Apa iya ada form dialog cetak yang lebih canggih dari buatan Microsoft Access? Jawabannya, iya bisa. Kita bisa membuat sendiri form dialog untuk mencetak report yang ada di Access.
Form View dari form cetak yang diaplikasikan untuk mencetak Voucher.
Keunggulan form dialog cetak yang dibuat sendiri ini antara lain:
  1. Bisa mencetak report sesuai dengan record yang diinginkan. Bila selama ini kita, misalnya menggunakan perintah dari record 1-7 (nomor 1 sampai nomor 7), maka dengan form ini kita bisa mencetak record sembarang, misalnya 1-7 (nomor 1 sampai nomor 7), 9 (nomor 9), 13 (nomor 13), dst.
  2. Bisa mencetak report sesuai dengan halaman yang diinginkan. Sama seperti di atas, bila selama ini kita, misalnya menggunakan perintah dari halaman 1-7 (halaman 1 sampai halaman 7), maka dengan form ini kita bisa mencetak halaman sembarang, misalnya 1-7 (halaman 1 sampai halaman 7), 9 (halaman 9), 13 (halaman 13), dst. Mirip seperti menuliskan halaman di Word.
  3. Ada keunggulan lain yang bisa ditambahkan sesuai dengan keinginan kita, misalnya dengan menambahkan properti margin.
Lalu bagaimana cara membuatnya? Well, jawabannya, ikuti petunjuk berikut ini.

Terlebih dahulu, ikuti petunjuk yang ada di posting berikut ini:
  1. Fungsi Untuk Membuat Daftar Printer di Access VBA
  2. Fungsi Untuk Membuat Daftar Ukuran Kertas di Access VBA
  3. Membuat Fungsi Untuk Daftar Paper Tray/Bin (Tempat Kertas Printer)
Setelah itu, untuk memulai, kita menggunakan form Form1 yang ada di posting Membuat Fungsi Untuk Daftar Paper Tray/Bin (Tempat Kertas Printer). Untuk memudahkan pemahaman, kita rename dulu nama form Form1 menjadi frmCetak. Setelah itu, sisipkan sejumlah kontrol berikut ini ke dalam form frmCetak.
Design View form frmCetak secara keseluruhan
  1. Option group, lihat gambar bawah, dengan properti Name= fraPilihRecord (1), dengan dua option button dan satu text box sebagai berikut:
    1. Properti option button 1: Name= optRecordYgAktif (2), Option Value= 0. Properti untuk label yang melekat pada option optRecordYgAktif: Name= lblRecordYgAktif (3), Caption= Record Yang Aktif.
    2. Properti option button 2: Name= optRecordDlmRange (4), Option Value= 1. Properti untuk label yang melekat pada option optRecordDlmRange: Caption= Record Sebagai Berikut.
    3. Di dalam Option Group frmPilihRecord, sisipkan sebuah text box di samping label yang mempunyai Caption= Record Sebagai Berikut. Properti text box adalah sebagai berikut: Name= txtRange (5).
      Bagian-bagian dari option group fraPilihRecord
  2. Pada bagian kanan form frmCetak, kita sisipkan option group lainnya dengan properti Name= fraOrientasi, dengan dua option button sebagai berikut:
    1. Properti option button 1: Name= optPotrait, Option Value= 1. Properti untuk label yang melekat pada option optPotrait: Name= lblPotrait, Caption= Potrait.
    2. Properti option button 2: Name= optLandscape, Option Value= 2. Properti untuk label yang melekat pada option optLandscape: Name= lblLandscape, Caption= Landscape.
  3. Di bawah option group fraOrientasi, sisipkan sebuah check box dengan properti Name= cbxCetakDatanyaSaja. Properti label yang melekat check box ini, Caption= Cetak Datanya Saja (abaikan format, label, dan sejenisnya).
  4. Di bawah combo box cbbPaperBin, sisipkan sebuah text box dengan properti: Name= txtSalinan. Properti label yang melekat text box ini, Caption= Jumlah Salinan.
  5. Di bawah text box txtSalinan, sisipkan sebuah text box dengan properti: Name= txtHalamanDlmRange. Properti label yang melekat text box ini, Caption= Halaman Sebagai Berikut.
  6. Sisipkan empat buah tombol perintah atau command button dengan rincian properti sebagai berikut:
    1. Tombol perintah 1: Name= cmdPrintPreview, Caption= Print Preview
    2. Tombol perintah 2: Name= cmdReportView, Caption= Report View
    3. Tombol perintah 3: Name= cmdCetak, Caption= Cetak
    4. Tombol perintah 4: Name= cmdBatal, Caption= Batal/Tutup
Berikut ini adalah kode yang harus ditambahkan di modul mdlPrinter:
Function aturPrintPreview(strRptName As String, Optional intModeWindow As AcWindowMode = acWindowNormal, _
                          Optional boolCetakLaporan As Boolean = False)
  Dim lngHalaman As Variant
  Dim strSelectedPage As String
  Dim strNamaPrinter As String
  Dim n As Integer
  Dim prtApp As Printer
  Dim strPrinter As String, strPaperSize As String, strPaperBin As String, _
              intCopies As Integer, intOrientation As Integer, boolDataOnly As Boolean
  Dim intNomorUkuranKertas, intNomorPaperBin As Integer

On Error GoTo Err_Msg
  DoCmd.OpenReport strRptName, acPreview, , , intModeWindow
  With Form_frmCetak
    strNamaPrinter = .cbbPrinter
    strPrinter = IIf(IsNull(.cbbPrinter), .cbbPrinter.ItemData(1), .cbbPrinter)
    strPaperSize = IIf(IsNull(.cbbUkuranKertas), .cbbUkuranKertas.ItemData(1), .cbbUkuranKertas)
    If IsNull(.cbbUkuranKertas) Then
      .cbbUkuranKertas = .cbbUkuranKertas.ItemData(1)
    End If
    intNomorUkuranKertas = .cbbUkuranKertas.Column(0)
    If Not IsNull(.cbbPaperBin.Column(0)) Then
      intNomorPaperBin = .cbbPaperBin.Column(0)
      strPaperBin = .cbbPaperBin.ItemData(1)
    End If
    intCopies = IIf(IsNull(.txtSalinan), 1, .txtSalinan)
    intOrientation = .fraOrientasi
    boolDataOnly = .cbxCetakDatanyaSaja
  End With
    ' Get selected printer and set user-specified settings
  Set prtApp = Application.Printers(menghitungUrutanPrinter(strPrinter))
  With prtApp
    .PaperSize = intNomorUkuranKertas
    .PaperBin = intNomorPaperBin
    .Copies = intCopies
    .Orientation = intOrientation
    .DataOnly = boolDataOnly
  End With
  ' Set report's printer to selected printer.
  Reports(strRptName).Printer = prtApp
  'Exit Function
  If boolCetakLaporan Then
    cetakLaporan strRptName
    DoCmd.Close acReport, strRptName
  End If
    
Exit_Function:
    Exit Function
    
Err_Msg:
    MsgBox Err.description, vbCritical & vbOKOnly, _
        "Error Number " & Err.Number & " Occurred"
    Resume Exit_Function
End Function

Function cetakLaporan(strRptName As String)
  Dim lngHalaman As Variant
  Dim i, n As Integer
  Dim strItem As Variant
  Dim strPrinterPengecualian() As Variant
On Error GoTo Err_Msg
  With Form_frmCetak
'dua pernyataan di bawah ini saling berkaitan,
    ReDim Preserve strPrinterPengecualian(2) 'Bila nilai strPrinterPengecualian ada sejumlah X item, maka item Array() di bawah ini juga harus ada sejumlah X.
    strPrinterPengecualian = Array("PDF", "XPS") 'Isikan nilai item Array() sejumlah nilai strPrinterPengecualian di atas.
    
    For i = LBound(strPrinterPengecualian) To UBound(strPrinterPengecualian)
      If InStr(1, .cbbPrinter, CStr(strPrinterPengecualian(i))) <> 0 Then
        If Not IsNull(.txtHalamanDlmRange) Then
          strMsg = "Format " & strPrinterPengecualian(i) & " hanya bisa digunakan untuk menyimpan semua halaman dalam satu file"
          strMsg = strMsg & vbCrLf & "Simpan semua halaman dalam satu file?"
          If MsgBox(strMsg, vbYesNo) = vbNo Then Exit Function
        End If
        DoCmd.PrintOut
        Exit Function
      End If
    Next i
    If IsNull(.txtHalamanDlmRange) Then
      lngHalaman = Array(1)
      DoCmd.PrintOut
      Exit Function
    Else
      lngHalaman = Split(mengaturKriteriaHalaman, ",")
    End If
  
    For n = LBound(lngHalaman) To UBound(lngHalaman)
      If InStr(1, lngHalaman(n), "-") <> 0 Then
        strItem = Split(lngHalaman(n), "-")
Debug.Print CLng(strItem(0))
        If Not IsNumeric(Trim(strItem(0))) And Not IsNumeric(Trim(strItem(1))) Then
          MsgBox "Nilai yang dimasukkan bukan angka", vbExclamation
          Cancel = True
          Exit Function
        End If
        If CInt(Trim(strItem(0))) > CInt(Trim(strItem(1))) Then
          MsgBox Trim(strItem(0)) & " harus lebih kecil dari " & (Trim(strItem(1))), vbExclamation
          Cancel = True
          Exit Function
        End If
        For i = CInt(Trim(strItem(0))) To CInt(Trim(strItem(1)))
'Debug.Print CLng(strItem(n))
          DoCmd.PrintOut acPages, i, i, acDraft
        Next i
      Else
Debug.Print CLng(lngHalaman(n))
        DoCmd.PrintOut acPages, CLng(lngHalaman(n)), CLng(lngHalaman(n)), acDraft
      End If
    Next n
  End With
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function cetakLaporan, Error # " & str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.description
  Resume Exit_Function
End Function

Function membukaFormCetak(strsql As String, strNamaReport As String, _
                          Optional strNamaTabel As String = vbNullString, _
                          Optional strNamaField As String = vbNullString, _
                          Optional varNilaiField As Variant = vbNullString, _
                          Optional boolRecordYgAktif As Boolean = True, _
                          Optional boolSelectedRecord As Boolean = True, _
                          Optional intOrientasi As AcPrintOrientation = acPRORPortrait, _
                          Optional boolCetakDatanyaSaja As Boolean = False)
  Dim varNilaiField2 As Variant
  Dim strCaption As String
On Error GoTo Err_Msg
  varNilaiField2 = konversiNilaiField(strNamaField, strNamaTabel, varNilaiField)
  If varNilaiField <> vbNullString Then
    strCaption = arrayTampilkanPropertiField(strNamaField, strNamaTabel, prpCaption)
  End If
  TempVars.Add "rptRecordSource", strsql
  TempVars.Add "rptNamaReport", strNamaReport
  TempVars.Add "tmpNamaTabel", strNamaTabel
  TempVars.Add "tmpNamaField", strNamaField
  TempVars.Add "tmpNilaiField2", CStr(varNilaiField)
  
  DoCmd.OpenForm "frmCetak"
  With Form_frmCetak
    If strNamaField <> vbNullString Then
    .fraPilihRecord = 0
    If boolRecordYgAktif Then
      .lblRecordYgAktif.Caption = .lblRecordYgAktif.Caption & " (" & strCaption & "=" & varNilaiField2 & ")"
    End If
    End If
    .fraOrientasi = intOrientasi
    .cbxCetakDatanyaSaja = boolCetakDatanyaSaja
    .cbbPrinter.SeparatorCharacters = 2
    .cbbPrinter.RowSource = Join(membuatDaftarPrinter, ";")
    .cbbPrinter = Application.Printer.DeviceName
    membuatDaftarUkuranKertas Forms(.Name), .cbbUkuranKertas, menghitungUrutanPrinter(.cbbPrinter)
    .cbbUkuranKertas = .cbbUkuranKertas.ItemData(1)
    membuatDaftarPaperBin Forms(.Name), .cbbPaperBin, .cbbPrinter
  End With
  strNamaReport1 = strNamaReport
  strSQLStatement1 = strsql
  If strNamaField <> vbNullString Then
    strSQLStatement1 = strSQLStatement1 & " WHERE " & strNamaField & "=" & varNilaiField2
  End If
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function membukaFormCetak, Error # " & str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.description
  Resume Exit_Function
End Function

Function mengaturKriteriaHalaman() As Variant
  Dim strWhere As String, strItem As Variant
  Dim strItem2 As Variant
  Dim i, j, m, n As Integer
  Dim strOItem() As Variant
  Dim globalCriteria As String
On Error GoTo Err_Msg
  strResult = vbNullString

  With Form_frmCetak
    strItem = Split(.txtHalamanDlmRange, ",")
    i = 0
    For n = LBound(strItem) To UBound(strItem)
    
      If CStr(strItem(n)) = vbNullString Then
        strResult = "Ada nilai yang tidak sesuai di " & .txtHalamanDlmRange
        MsgBox strResult
        Exit Function
      End If
      If InStr(1, strItem(n), "-") <> 0 Then
        strItem2 = Split(strItem(n), "-")
        If Not IsNumeric(strItem2(0)) Then
          MsgBox strItem2(0) & " bukan angka!", vbCritical
          Exit Function
        End If
        If Not IsNumeric(strItem2(1)) Then
          MsgBox strItem2(1) & " bukan angka!", vbCritical
          Exit Function
        End If
        If CLng(strItem2(0)) > CLng(strItem2(1)) Then
          MsgBox strItem2(1) & " harus lebih besar atau sama dengan " & CLng(strItem2(0)) & "!", vbCritical
          Exit Function
        End If
        For m = CLng(strItem2(0)) To CLng(strItem2(1))
          ReDim Preserve strOItem(i + 1)
          strOItem(i) = m
          i = i + 1
        Next m
      Else
        If Not IsNumeric(strItem(n)) Then
          MsgBox strItem(n) & " bukan angka!", vbCritical
          Exit Function
        End If
        ReDim Preserve strOItem(i + 1)
        strOItem(i) = Trim(strItem(n))
        i = i + 1
      End If
    Next n
  ReDim Preserve strOItem(i - 1)
  globalCriteria = Join(strOItem, ",")
  End With
  mengaturKriteriaHalaman = globalCriteria
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function mengaturKriteriaHalaman, Error # " & str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.description
  Resume Exit_Function
End Function

Function mengaturKriteriaRange(strNamaField As String, strNamaTabel As String) As String
  Dim strWhere As String, strItem As Variant
  Dim strItem2 As Variant
  Dim i, n As Integer
  Dim strOItem() As String
  Dim strOItem2() As String
  Dim globalCriteria As String
On Error GoTo Err_Msg
  strResult = vbNullString

  With Form_frmCetak
    If .fraPilihRecord = 0 Then
      strItem = Split([TempVars]![tmpNilaiField2], ",")
    Else
      strItem = Split(.txtRange, ",")
    End If
    i = 0
    
    ReDim Preserve strOItem2(UBound(strItem))
    For n = LBound(strItem) To UBound(strItem)
      strOItem2(n) = Trim(strItem(n))
    Next n
    strItem = strOItem2

    For n = LBound(strItem) To UBound(strItem)
      If strItem(n) = "" Then
        strResult = "Ada nilai yang kosong di: " & .txtRange
        MsgBox strResult
        mengaturKriteriaRange = vbNullString
        Exit Function
      End If
      
      If InStr(1, strItem(n), "-") <> 0 Then
        strItem2 = Split(strItem(n), "-")
        If arrayTampilkanPropertiField(strNamaField, strNamaTabel, prpTypeGlobal) = "Text" Then
          If Not (adaNilaiField(strNamaField, strNamaTabel, CStr(Trim(strItem2(0)))) Or _
          adaNilaiField(strNamaField, strNamaTabel, CStr(Trim(strItem2(1))))) Then
            ReDim Preserve strOItem(i + 1)
            strOItem(i) = "in " & strItem(n)
            i = i + 1
          End If
          strItem(n) = strNamaField & " BETWEEN '" & Trim(strItem2(0)) & "'" & " AND '" & Trim(strItem2(1)) & "'"
        ElseIf arrayTampilkanPropertiField(strNamaField, strNamaTabel, prpTypeGlobal) = "Date" Then
          If Not IsDate(strItem2(0)) Or Not IsDate(strItem2(1)) Then
            strResult = "Tipe data tidak tepat di " & strItem(n)
            globalCriteria = vbNullString
            Exit Function
          End If
          If Not (adaNilaiField(strNamaField, strNamaTabel, CStr(Trim(strItem2(0)))) Or _
          adaNilaiField(strNamaField, strNamaTabel, CStr(Trim(strItem2(1))))) Then
            ReDim Preserve strOItem(i + 1)
            strOItem(i) = "in " & strItem(n)
            i = i + 1
          End If
          strItem(n) = strNamaField & " BETWEEN #" & Trim(strItem2(0)) & "#" & " AND #" & Trim(strItem2(1)) & "#"
        Else
          If Not IsNumeric(strItem2(0)) Or Not IsNumeric(strItem2(1)) Then
            strResult = "Tipe data tidak tepat di " & strItem(n)
            globalCriteria = vbNullString
            Exit Function
          End If
          If Not (adaNilaiField(strNamaField, strNamaTabel, CStr(Trim(strItem2(0)))) Or _
          adaNilaiField(strNamaField, strNamaTabel, CStr(Trim(strItem2(1))))) Then
            ReDim Preserve strOItem(i + 1)
            strOItem(i) = "in " & strItem(n)
            i = i + 1
          End If
          strItem(n) = strNamaField & " BETWEEN " & Trim(strItem2(0)) & " AND " & Trim(strItem2(1))
        End If
      Else
        If arrayTampilkanPropertiField(strNamaField, strNamaTabel, prpTypeGlobal) = "Text" Then
          If Not adaNilaiField(strNamaField, strNamaTabel, CStr(strItem(n))) Then
            ReDim Preserve strOItem(i + 1)
            strOItem(i) = strItem(n)
            i = i + 1
          End If
          strItem(n) = strNamaField & "='" & strItem(n) & "'"
        ElseIf arrayTampilkanPropertiField(strNamaField, strNamaTabel, prpTypeGlobal) = "Date" Then
          If Not IsDate(strItem(n)) Then
            strResult = "Tipe data tidak tepat di " & strItem(n)
            globalCriteria = vbNullString
            Exit Function
          End If
          If Not adaNilaiField(strNamaField, strNamaTabel, CStr(strItem(n))) Then
            ReDim Preserve strOItem(i + 1)
            strOItem(i) = strItem(n)
            i = i + 1
          End If
          strItem(n) = strNamaField & "=#" & strItem(n) & "#"
        Else
          If Not IsNumeric(strItem(n)) Then
            strResult = "Tipe data tidak tepat di " & strItem(n)
            globalCriteria = vbNullString
            Exit Function
          End If
          If Not adaNilaiField(strNamaField, strNamaTabel, CStr(strItem(n))) Then
            ReDim Preserve strOItem(i + 1)
            strOItem(i) = strItem(n)
            i = i + 1
          End If
          strItem(n) = strNamaField & "=" & strItem(n)
        End If
      End If
    Next n
    If i > 0 Then
      strResult = "Nilai data tak dikenal:" & vbCrLf & vbCrLf & Join(strOItem, vbCrLf)
      MsgBox strResult
      globalCriteria = vbNullString
    Else
      globalCriteria = Join(strItem, " Or ")
    End If
  mengaturKriteriaRange = globalCriteria
  End With
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Function mengaturKriteriaRange, Error # " & str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.description
  Resume Exit_Function
End Function
Langkah berikutnya, ganti kode VBA di modul form frmCetak dengan kode VBA di bawah ini:
Option Compare Database

Private Sub cbbPrinter_Change()
  membuatDaftarUkuranKertas Forms(Me.Name), Controls(Me.cbbUkuranKertas.Name), menghitungUrutanPrinter(Me.cbbPrinter)
  membuatDaftarPaperBin Forms(Me.Name), Controls(Me.cbbPaperBin.Name), Me.cbbPrinter
End Sub
Private Sub cmdCetak_Click()
  If Not validasi Then Exit Sub
  If seleksi Then aturPrintPreview [TempVars]![rptNamaReport], , True
End Sub

Private Sub cmdPrintView_Click()
  If Not validasi Then Exit Sub
  If seleksi Then aturPrintPreview [TempVars]![rptNamaReport]

End Sub
Private Function validasi() As Boolean
  Dim blnIsValidPrinter As Boolean
  Dim ukuranKertas() As String
  ' Jika printer tidak ada lakukan prosedur di bawah ini
  If IsNull(Me.cbbPrinter.Value) Then
      MsgBox Prompt:="Pilih nama printer yang sesuai."
      Me.cbbPrinter = Application.Printer.DeviceName
      validasi = False
      Exit Function
  End If
  blnIsValidPrinter = False
  
  ' Periksa apakah printer sudah valid
  For Each prt In Application.Printers
      If prt.DeviceName = Me.cbbPrinter.Value Then
          blnIsValidPrinter = True
      End If
  Next
  
  ' Jika printer tidak valid lakukan prosedur di bawah ini.
  If Not blnIsValidPrinter Then
      MsgBox "Pilih printer yang sesuai"
      Me.cbbPrinter = Application.Printer.DeviceName
      validasi = False
      Exit Function
  End If
  
  blnIsValidPrinter = False
  ReDim Preserve ukuranKertas(Me.cbbUkuranKertas.ListCount - 1)
  For n = 0 To Me.cbbUkuranKertas.ListCount - 1
    ukuranKertas(n) = Me.cbbUkuranKertas.ItemData(n)
    If Me.cbbUkuranKertas = ukuranKertas(n) Then
      blnIsValidPrinter = True
    End If
  Next n
  If Not blnIsValidPrinter Then
    MsgBox "Pilih ukuran kertas yang sesuai"
    validasi = False
    Exit Function
  End If
  validasi = True
End Function
Private Function seleksi() As Boolean
  If Me.fraPilihRecord = 0 Then
    TempVars.Add "rptRecordSource1", [TempVars]![rptRecordSource] & " WHERE " & _
      mengaturKriteriaRange([TempVars]![tmpNamaField], [TempVars]![tmpNamaTabel])
  Else
    If IsNull(Me.txtRange) Then
      TempVars.Remove "rptRecordSource2"
      TempVars.Remove "rptRecordSource1"
      TempVars.Add "rptRecordSource1", CStr([TempVars]![rptRecordSource])
      seleksi = True
      Exit Function
    Else
      If mengaturKriteriaRange([TempVars]![tmpNamaField], [TempVars]![tmpNamaTabel]) = vbNullString Then
        seleksi = False
        Exit Function
      Else
        TempVars.Add "rptRecordSource1", [TempVars]![rptRecordSource] & " WHERE " & _
          mengaturKriteriaRange([TempVars]![tmpNamaField], [TempVars]![tmpNamaTabel])
      End If
    End If
  End If
  seleksi = True
End Function
Private Sub cmdReportView_Click()
  If seleksi Then DoCmd.OpenReport [TempVars]![rptNamaReport], acViewReport
End Sub

Private Sub Form_Close()
  TempVars.Remove "rptRecordSource"
  TempVars.Remove "rptNamaReport"
  TempVars.Remove "tmpNamaTabel"
  TempVars.Remove "tmpNamaField"
  TempVars.Remove "tmpNilaiField2"
  TempVars.Remove "rptRecordSource1"
End Sub

Private Sub txtRange_GotFocus()
  Me.fraPilihRecord = 1
End Sub
Untuk dapat menjalankan kode VBA di atas, ada fungsi-fungsi tertentu yang harus dibuat terlebih dahulu. Jadi, fungsi-fungsi di atas tidak berdiri sendiri, mereka tergantung pada fungsi lain yang ada di halaman Database Front-end dan Back-end terutama fungsi yang ada di modul mdlCore, nomor 1 s/d 27. Ke-27 fungsi itu harus ada.

Terakhir, pada report yang ingin di printview, report view, atau dicetak, sisipkan event procedure on Open sebagai berikut:
Private Sub Report_Open(Cancel As Integer)
  If Not IsNull([TempVars]![rptRecordSource1]) Then Me.RecordSource = [TempVars]![rptRecordSource1]
End Sub
Untuk membuka form frmCetak, kita harus menyisipkan sebuah tombol perintah yang digunakan untuk membuka form itu, melalui event procedure On Click. Contohnya pada gambar di bawah ini.


Pada tombol, misalnya ber-caption Open Print Report (properti Name=cmdPrintReport) event On Click, sisipkan kode VBA berikut ini:
Private Sub cmdPrintReport_Click()
  If IsNull(Me.vouchId) Then
    membukaFormCetak "SELECT tblVoucherTemp.*, tblVoucherTempEntries.*, tblPrimaryAccountsFin.primaryaccountName, " _
    & "tblTipeDokumen.docDeskripsi FROM ((tblVoucherTemp INNER JOIN tblPrimaryAccountsFin ON " _
    & "tblVoucherTemp.vouchPrimaryAccountCode = tblPrimaryAccountsFin.documentCoding) LEFT JOIN " _
    & "tblVoucherTempEntries ON tblVoucherTemp.vouchId = tblVoucherTempEntries.vouchId) INNER JOIN " _
    & "tblTipeDokumen ON tblVoucherTemp.vouchType = tblTipeDokumen.dokTipe", "rptVoucherTemp", False, , acPRORPortrait, True
  Else
    membukaFormCetak "SELECT tblVoucherTemp.*, tblVoucherTempEntries.*, tblPrimaryAccountsFin.primaryaccountName, tblTipeDokumen.docDeskripsi FROM ((tblVoucherTemp INNER JOIN tblPrimaryAccountsFin ON tblVoucherTemp.vouchPrimaryAccountCode = tblPrimaryAccountsFin.documentCoding) LEFT JOIN tblVoucherTempEntries ON tblVoucherTemp.vouchId = tblVoucherTempEntries.vouchId) INNER JOIN tblTipeDokumen ON tblVoucherTemp.vouchType = tblTipeDokumen.dokTipe", "rptVoucherTemp", "tblVoucherTemp", _
    "tblVoucherTemp.vouchId", Me.vouchId, , , acPRORPortrait, True
  End If
End Sub
Dengan demikian, saat tombol Open Print Report diklik, form frmCetak akan terbuka dengan isi form yang sudah diatur terlebih dahulu melalui fungsi membukaFormCetak.

Untuk memahami penerapan form cetak dan fungsi VBA yang mendukung didalamnya, kita dapat melihat video demonya di bawah ini

Pada video itu kita bisa mencetak record sesuai dengan keinginan, baik melalui primary key, maupun melalui halaman tertentu. Sangat fleksibel. Contohnya, 1,5 menit terakhir dari video demo itu berisi halaman tertentu yang dicetak sesuai dengan pengaturan nomor halaman di form cetak.

Khusus untuk primary key, ada tiga tipe data yang bisa dibaca, Number, Text, dan Date/Time. Jadi misalnya primary key untuk Number: 1,2,3,5-9, 21-34, dst., untuk Text misalnya AMB, BDG-JKT, MRK, dst., untuk Date misalnya, 1/21/2018, 1/23/2018-1/24/2018, dst. Jadi, kita tidak perlu menggunakan tanda "'"  (tanda petik tunggal) untuk menyatakan tipe datanya berupa Text atau "#" (tanda pagar) untuk menyatakan tipe datanya berupa Date/Time.

SILAKAN DICOBA!!!😎. .

Comments

  1. gan mau tanya, kalo semisal saya buat form dialog cetak tapi isinya cuman list printer yang ada di control panel dan bisa langsung nyambung dengan report dan printernya yang di pilih itu diambil kodingnya yg mana aja ya ?? terima kasih

    ReplyDelete
    Replies
    1. Kalau seperti itu nggak perlu pakai koding. Pakai saja standard umum yang biasa dipakai Access.

      Delete
  2. standart yg dipakai acces tidak terdapat pilihan printernya, sempet coba DoCmd.RunCommand acCmdPrint tp ketika sudah dipilih printernya settingan printernya tidak mau mengikuti settingan printer di control panel. tujuan saya bikin form dialog cetak sendiri agar bisa mengganti pilihan printer agar tidak bingung" mengubah default printer di control panel,dan ketika printer yg dipilih di form dialog sendiri, bisa langsung otomatis conect printer sekaligus settingan seperti kertas dll di control panel

    ReplyDelete
    Replies
    1. Yang saya buat di atas sebenarnya sudah mewakili apa yang kamu inginkan. Hanya, koding yang aku buat di situ termasuk koding untuk menjalankan Access di backend dan frontend, jadi terlihat kompleks.

      Coba saja mulai dari fungsi "Function aturPrintPreview", siapa tahu bisa ditemukan apa yang kamu mau.

      Delete
  3. satu lagi mas, koding ini bisa dibuat di access xp kah ?? soalnya yang saya pakai office xp (access xp)

    ReplyDelete
    Replies
    1. Sebagian besar koding itu untuk Access 2007. Kamu punya Access edisi berapa?

      Delete

Post a Comment

Posting Terpopuler

Format Untuk Field Dengan Tipe Data Number dan Currency di MS Access

Normalisasi, Denormalisasi, dan Anomali Database

Membuat Fungsi Untuk Menghitung Pajak Penghasilan PPh 21 di MS Access