Fungsi Untuk Membuat Daftar Ukuran Kertas di Access VBA

Di Access, untuk menampilkan ukuran kertas kita harus memilih sebuah report terlebih dulu dan membukanya. Setelah report terbuka, kita memilih ukuran kertas yang diinginkan dengan mengklik Page Setup dan masuk ke tab Page.

Pada tab Page, kita bisa memilih ukuran kertas yang diinginkan, seperti terlihat pada gambar di atas. Walau Access sudah menyediakan daftar jenis kertas, kita bisa bisa saja membuat daftar jenis kertas yang dilengkapi dengan ukuran. Dengan demikian, kita dapat memilih kertas secara lebih akurat, sesuai dengan kebutuhan.

Untuk menampilkan daftar jenis kertas yang dilengkapi dengan ukuran, kita bisa membuat fungsi di Access VBA. Berbeda dengan fungsi untuk  membuat daftar printer yang terlihat sederhana, fungsi untuk membuat daftar ukuran kertas jauh lebih kompleks. Berikut ini adalah fungsinya, yang diberi nama membuatDaftarUkuranKertas. Tambahkanlah fungsi di bawah ini dalam modul standar yang bernama mdlPrinter, karena kita akan membutuhkannya nanti.

Fungsi ini diambil dari https://msdn.microsoft.com/en-us/vba/access-vba/articles/programmatically-retrieve-printer-capabilities dan diolah kembali.

view plainprint?

1. ' Declaration for the DeviceCapabilities function API call.   
2. Private Declare PtrSafe Function DeviceCapabilities Lib "winspool.drv" _  
3.     Alias "DeviceCapabilitiesA" (ByVal lpsDeviceName As String, _  
4.     ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _  
5.     ByVal lpDevMode As Long) As Long  
6.   
7. ' DeviceCapabilities function constants.  
8. Private Const DC_PAPERNAMES = 16  
9. Private Const DC_PAPERS = 2  
10. Private Const DC_BINNAMES = 12  
11. Private Const DC_PAPERSIZE = 3  
12. Private Const DC_BINS = 6  
13. Private Const DEFAULT_VALUES = 0  
14. 'define custom type for POINTAPI  
15. Private Type POINTAPI  
16.     X As Long  
17.     Y As Long  
18. End Type  
19. Function menghitungUrutanPrinter(strNamaPrinter As String) As Integer  
20.   Dim Cnt As Integer  
21.   For Cnt = 0 To Application.Printers.Count - 1  
22.     If InStr(1, Application.Printers(Cnt).DeviceName, strNamaPrinter) > 0 Then  
23.       menghitungUrutanPrinter = Cnt  
24.     End If  
25.   Next Cnt  
26. End Function  
27. Public Function membuatDaftarUkuranKertas(frmName As Form, cbbPaperSize As Access.ComboBox, Printer As Integer)  
28.     Dim lngPaperCount As Long  
29.     Dim lngCounter As Long  
30.     Dim hPrinter As Long  
31.     Dim strDeviceName As String  
32.     Dim strDevicePort As String  
33.     Dim strPaperNamesList As String  
34.     Dim strPaperName As String  
35.     Dim i, intLength As Integer  
36.     Dim strMsg As String  
37.     Dim aintNumPaper() As Integer  
38.     Dim intPaperSizeNumber As Integer  
39.     Dim strPaperSize() As String  
40.     Dim Pnt() As POINTAPI  
41. On Error GoTo Err_Msg  
42.     ' Get the name and port of the selected printer.  
43.     strDeviceName = Application.Printers(Printer).DeviceName  
44.     strDevicePort = Application.Printers(Printer).Port  
45.   
46.     ' Get the count of paper names supported by the printer.  
47.     lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _  
48.         lpPort:=strDevicePort, _  
49.         iIndex:=DC_PAPERNAMES, _  
50.         lpOutput:=ByVal vbNullString, _  
51.         lpDevMode:=DEFAULT_VALUES)  
52.       
53.     If lngPaperCount = 0 Then  
54.       cbbPaperSize.RowSource = vbNullString  
55.       Exit Function  
56.     End If  
57.   
58.     ' Re-dimension the array to the count of paper names.  
59.     ReDim aintNumPaper(1 To lngPaperCount)  
60.     ReDim Pnt(1 To lngPaperCount)  
61.   
62.     ' Pad the variable to accept 64 bytes for each paper name.  
63.     strPaperNamesList = String(64 * lngPaperCount, 0)  
64.       
65.     ' Get the string buffer of all paper names supported by the printer.  
66.     lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _  
67.         lpPort:=strDevicePort, _  
68.         iIndex:=DC_PAPERNAMES, _  
69.         lpOutput:=ByVal strPaperNamesList, _  
70.         lpDevMode:=DEFAULT_VALUES)  
71.   
72.     ' Get the array of all paper numbers supported by the printer.  
73.     lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _  
74.         lpPort:=strDevicePort, _  
75.         iIndex:=DC_PAPERS, _  
76.         lpOutput:=aintNumPaper(1), _  
77.         lpDevMode:=DEFAULT_VALUES)  
78.   
79.     'get point list of paper sizes for each paper  
80.     lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _  
81.         lpPort:=strDevicePort, iIndex:=DC_PAPERSIZE, lpOutput:=Pnt(1), lpDevMode:=0)  
82.       
83.     ' List the available paper names.  
84.     ReDim Preserve strPaperSize(lngPaperCount - 1)  
85.     
86.   With frmName  
87.     With cbbPaperSize  
88.       .RowSource = ""  
89.       .RowSourceType = "Value List"  
90.       .SeparatorCharacters = acSeparatorCharactersSemiColon  
91.       .ColumnCount = 4  
92.       .ColumnHeads = True  
93.       .AddItem Item:="Nomor;Ukuran;Lebar (cm);Panjang (cm)"  
94.       .BoundColumn = 2  
95.       .ListWidth = 4 * 1440  
96.       .ColumnWidths = "0 In;2 In;1 In;1 In"  
97.       i = 0  
98.       For lngCounter = 1 To lngPaperCount  
99.         
100.         ' Parse a paper name from the string buffer.  
101.         strPaperName = Mid(String:=strPaperNamesList, Start:=64 * (lngCounter - 1) + 1, Length:=64)  
102.           
103.         intLength = VBA.InStr(Start:=1, String1:=strPaperName, String2:=Chr(0)) - 1  
104.         strPaperName = Left(String:=strPaperName, Length:=intLength)  
105.          intPaperSizeNumber = aintNumPaper(lngCounter)  
106.         .AddItem Item:=intPaperSizeNumber & "; " & strPaperName & "; " & Pnt(lngCounter).X / 100 & "; " & Pnt(lngCounter).Y / 100  
107.         i = i + 1  
108.       Next lngCounter  
109.     End With  
110.   End With  
111.   
112. Exit_Function:  
113.     Exit Function  
114. Err_Msg:  
115.     MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _  
116.         Title:="Error Number " & Err.Number & " Occurred"  
117.     Resume Exit_Function  
118. End Function  

' Declaration for the DeviceCapabilities function API call. 
Private Declare PtrSafe Function DeviceCapabilities Lib "winspool.drv" _
    Alias "DeviceCapabilitiesA" (ByVal lpsDeviceName As String, _
    ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
    ByVal lpDevMode As Long) As Long

' DeviceCapabilities function constants.
Private Const DC_PAPERNAMES = 16
Private Const DC_PAPERS = 2
Private Const DC_BINNAMES = 12
Private Const DC_PAPERSIZE = 3
Private Const DC_BINS = 6
Private Const DEFAULT_VALUES = 0
'define custom type for POINTAPI
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Function menghitungUrutanPrinter(strNamaPrinter As String) As Integer
  Dim Cnt As Integer
  For Cnt = 0 To Application.Printers.Count - 1
    If InStr(1, Application.Printers(Cnt).DeviceName, strNamaPrinter) > 0 Then
      menghitungUrutanPrinter = Cnt
    End If
  Next Cnt
End Function
Public Function membuatDaftarUkuranKertas(frmName As Form, cbbPaperSize As Access.ComboBox, Printer As Integer)
    Dim lngPaperCount As Long
    Dim lngCounter As Long
    Dim hPrinter As Long
    Dim strDeviceName As String
    Dim strDevicePort As String
    Dim strPaperNamesList As String
    Dim strPaperName As String
    Dim i, intLength As Integer
    Dim strMsg As String
    Dim aintNumPaper() As Integer
    Dim intPaperSizeNumber As Integer
    Dim strPaperSize() As String
    Dim Pnt() As POINTAPI
On Error GoTo Err_Msg
    ' Get the name and port of the selected printer.
    strDeviceName = Application.Printers(Printer).DeviceName
    strDevicePort = Application.Printers(Printer).Port

    ' Get the count of paper names supported by the printer.
    lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
        lpPort:=strDevicePort, _
        iIndex:=DC_PAPERNAMES, _
        lpOutput:=ByVal vbNullString, _
        lpDevMode:=DEFAULT_VALUES)
    
    If lngPaperCount = 0 Then
      cbbPaperSize.RowSource = vbNullString
      Exit Function
    End If

    ' Re-dimension the array to the count of paper names.
    ReDim aintNumPaper(1 To lngPaperCount)
    ReDim Pnt(1 To lngPaperCount)

    ' Pad the variable to accept 64 bytes for each paper name.
    strPaperNamesList = String(64 * lngPaperCount, 0)
    
    ' Get the string buffer of all paper names supported by the printer.
    lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
        lpPort:=strDevicePort, _
        iIndex:=DC_PAPERNAMES, _
        lpOutput:=ByVal strPaperNamesList, _
        lpDevMode:=DEFAULT_VALUES)

    ' Get the array of all paper numbers supported by the printer.
    lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
        lpPort:=strDevicePort, _
        iIndex:=DC_PAPERS, _
        lpOutput:=aintNumPaper(1), _
        lpDevMode:=DEFAULT_VALUES)

    'get point list of paper sizes for each paper
    lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
        lpPort:=strDevicePort, iIndex:=DC_PAPERSIZE, lpOutput:=Pnt(1), lpDevMode:=0)
    
    ' List the available paper names.
    ReDim Preserve strPaperSize(lngPaperCount - 1)
  
  With frmName
    With cbbPaperSize
      .RowSource = ""
      .RowSourceType = "Value List"
      .SeparatorCharacters = acSeparatorCharactersSemiColon
      .ColumnCount = 4
      .ColumnHeads = True
      .AddItem Item:="Nomor;Ukuran;Lebar (cm);Panjang (cm)"
      .BoundColumn = 2
      .ListWidth = 4 * 1440
      .ColumnWidths = "0 In;2 In;1 In;1 In"
      i = 0
      For lngCounter = 1 To lngPaperCount
      
        ' Parse a paper name from the string buffer.
        strPaperName = Mid(String:=strPaperNamesList, Start:=64 * (lngCounter - 1) + 1, Length:=64)
        
        intLength = VBA.InStr(Start:=1, String1:=strPaperName, String2:=Chr(0)) - 1
        strPaperName = Left(String:=strPaperName, Length:=intLength)
         intPaperSizeNumber = aintNumPaper(lngCounter)
        .AddItem Item:=intPaperSizeNumber & "; " & strPaperName & "; " & Pnt(lngCounter).X / 100 & "; " & Pnt(lngCounter).Y / 100
        i = i + 1
      Next lngCounter
    End With
  End With

Exit_Function:
    Exit Function
Err_Msg:
    MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _
        Title:="Error Number " & Err.Number & " Occurred"
    Resume Exit_Function
End Function

Ada dua fungsi yang digunakan untuk membuat daftar ukuran kertas. Yang pertama adalah fungsi menghitungUrutanPrinter yang digunakan untuk menentukan nomor urut printer yang ada di daftar printer. Untuk diketahui, setiap jenis printer mempunyai ukuran kertas yang belum tentu sama satu dengan lainnya. Misalnya, printer dengan ukuran kecil tentu hanya bisa digunakan untuk kertas yang ukurannya kecil. Sebaliknya, printer dengan ukuran besar, selain kertas ukuran besar bisa juga menggunakan kertas ukuran kecil. Jadi, sebelum menampilkan ukuran kertas, kita harus menentukan terlebih dulu nama jenis printer yang digunakan. Dari nama jenis printer ini, kita kemudian menentukan nomor urut printer.

Setelah nomor urut printer diketahui, fungsi membuatDaftarUkuranKertas dijalankan. Fungsi membuatDaftarUkuranKertas mempunyai tiga variabel, yaitu form yang aktif, control berupa combo box, dan nomor urut printer. Dengan demikian, untuk menjalankan fungsi membuatDaftarUkuranKertas, kita harus menyediakan, terutama, form dan control. Tanpa kedua variabel ini, fungsi tidak bisa dijalankan. Kita dapat menggunakan form yang ada di posting Fungsi Untuk Membuat Daftar Printer di Access VBA.

Sisipkan di bawah control combo box yang bernama cbbPrinter, sebuah combo box yang lain dengan properti sebagai berikut:

1. Name=cbbUkuranKertas
2. Row Source Type=Value List

Selanjutnya, kode VBA yang ada di modul form Form1 dihapus dan diganti dengan kode VBA berikut ini:

view plainprint?

1. Option Compare Database  
2.   
3. Private Sub cbbPrinter_Change()  
4.   membuatDaftarUkuranKertas Forms(Me.Name), Controls(Me.cbbUkuranKertas.Name), menghitungUrutanPrinter(Me.cbbPrinter)  
5. End Sub  
6.   
7. Private Sub Form_Open(Cancel As Integer)  
8.   Me.cbbPrinter.SeparatorCharacters = 2  
9.   Me.cbbPrinter.RowSource = Join(membuatDaftarPrinter, ";")  
10.   Me.cbbPrinter = Application.Printer.DeviceName  
11.   membuatDaftarUkuranKertas Forms(Me.Name), Controls(Me.cbbUkuranKertas.Name), menghitungUrutanPrinter(Me.cbbPrinter)  
12. End Sub  

Option Compare Database

Private Sub cbbPrinter_Change()
  membuatDaftarUkuranKertas Forms(Me.Name), Controls(Me.cbbUkuranKertas.Name), menghitungUrutanPrinter(Me.cbbPrinter)
End Sub

Private Sub Form_Open(Cancel As Integer)
  Me.cbbPrinter.SeparatorCharacters = 2
  Me.cbbPrinter.RowSource = Join(membuatDaftarPrinter, ";")
  Me.cbbPrinter = Application.Printer.DeviceName
  membuatDaftarUkuranKertas Forms(Me.Name), Controls(Me.cbbUkuranKertas.Name), menghitungUrutanPrinter(Me.cbbPrinter)
End Sub

Bila Form1 dibuka dengan cara Form View, hasilnya seperti ini:

Pada gambar di atas, printer yang digunakan bernama Send To OneNote 2013. Ukuran kertas yang ditampilkan jumlahnya terbatas. Beda dengan nama jenis printer di bawah ini.

Pada gambar di atas, kita menggunakan nama jenis printer EPSON L360 Series. Terlihat bahwa ukuran kertas untuk printer ini sangat bervariasi.

Dengan tampilan seperti gambar di atas, pengguna jadi lebih mudah memilih kertas yang diinginkan karena ada 3 kolom yang bisa menjelaskan ukuran kertas. Yang pertama kolom ukuran berisi penjelasan ukuran kertas. Yang kedua, lebar yang diukur dalam satuan cm. Yang ketiga, panjang yang juga diukur dalam satuan cm.