通过 VBA（Visual Basic For Applications）发送ZPL

本文介绍通过 VBA（Visual Basic for Application）发送ZPL脚本。

问题/疑问

如何在 Excel 中开发可以将ZPL发送到打印机的 VBA 程序？如何通过 VBA（Visual Basic for Application）发送ZPL脚本？

适用于

所有基于ZPL的条码打印机。 （不适用于 KR203、ZQ110、EM220 和 EM220II）

议决/解答

方法一：
使用 shell API 通过记事本将文本文件内容发送到通用/纯文本打印机驱动程序。通用文本驱动程序以 RAW 形式发送数据。内容不会以纯文本形式打印。确保内容是可运行的脚本。

程序：

添加通用/纯文本打印机。

将打印机设置为默认打印机。

在VBA IDE （Visual Basic for Application）集成开发环境中编程，将命令脚本保存到文本文件中。

在VBA IDE中编程，调用notepad.exe将文本文件打印到默认打印机。

样本：Private Sub SendCommand()
Dim fileName As String
Dim temp As String
On Error Resume Next
fileName = "d:\zpl.txt"
Kill fileName
Open fileName For Output As #1
Print #1, "^XA^FO50,60^A0N,20,20^FD" & Sheet1.Cells(2, 1) & "^FS^XZ"
Close #1
Shell "NOTEPAD.EXE /p " & fileName
End Sub

方法二：
使用Windows API调用winspool.drv ，将RAW数据发送到打印机驱动程序。

样本：
您应该将司机的姓名替换为您的姓名。
以下代码适用于 32 位Windows OS；如果您的系统是 64 位，则可能无法工作；请尝试以下示例。Type DOCINFO
 pDocName As String
 pOutputFile As String
 pDatatype As String
End Type

Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, hPrinter As Long, ByVal pDefault As Long) As Long
' Public Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (hPrinter As Long, Level As Long, dDocInfo As DOCINFO) As Long
Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, dDocInfo As DOCINFO) As Long
Declare Function StartPagePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Declare Function EndDocPrinter Lib "winspool.drv" (ByVal _
    hPrinter As Long) As Long
Declare Function EndPagePrinter Lib "winspool.drv" (ByVal _
    hPrinter As Long) As Long
Declare Function ClosePrinter Lib "winspool.drv" (ByVal _
    hPrinter As Long) As Long
Declare Function WritePrinter Lib "winspool.drv" (ByVal _
    hPrinter As Long, pBuf As Any, ByVal cdBuf As Long, _
    pcWritten As Long) As Long
Declare Function AbortPrinter Lib "winspool.drv" (ByVal _
    hPrinter As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long


Public Function printRawData(sPrinterName As String, lData As String) As Boolean
  Dim bStatus As Boolean, hPrinter As Long, dDocInfo As DOCINFO, lJob As Long, nWritten As Long

  ' Open a handle to the printer.
  bStatus = OpenPrinter(sPrinterName, hPrinter, 0)
  If bStatus Then
    ' Fill in the structure with info about this "document."
    dDocInfo.pDocName = "DemoPage"
    dDocInfo.pOutputFile = vbNullString
    dDocInfo.pDatatype = "RAW"

    ' Inform the spooler the document is beginning.
    lJob = StartDocPrinter(hPrinter, 1, dDocInfo) 'Returns 0 :(
    'Debug.Print hPrinter, sPrinterName, lJob, GetLastError()

    If lJob > 0 Then
        ' Start a page.
        bStatus = StartPagePrinter(hPrinter)
        If bStatus Then
            ' Send the data to the printer.
            bStatus = WritePrinter(hPrinter, ByVal lData, Len(lData), nWritten)
            EndPagePrinter (hPrinter)
        End If
        ' Inform the spooler that the document is ending.
        EndDocPrinter (hPrinter)
    End If
    ' Close the printer handle.
    ClosePrinter (hPrinter)
  End If

  ' Check to see if correct number of bytes were written.
  If Not bStatus Or (nWritten <> Len(lData)) Then
    printRawData = False
  Else
    printRawData = True
  End If
End Function

Sub btn1_Click()
'Only support windows 1252 or single byte encoding
Dim printData As String
printData = "^XA^FO50,60^A0N,20,20^FD" & Sheet1.Cells(2, 1) & "^FS^XZ"

Call printRawData("ZDesigner ZR328 (CPCL)", printData)
End Sub
Type DOCINFO
 pDocName As String
 pOutputFile As String
 pDatatype As String
End Type

Declare PtrSafe Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, hPrinter As LongPtr, ByVal pDefault As Long) As Long
' Public Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (hPrinter As Long, Level As Long, dDocInfo As DOCINFO) As Long
Declare PtrSafe Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrinter As LongPtr, ByVal Level As Long, dDocInfo As DOCINFO) As Long
Declare PtrSafe Function StartPagePrinter Lib "winspool.drv" (ByVal hPrinter As LongPtr) As Long
Declare PtrSafe Function EndDocPrinter Lib "winspool.drv" (ByVal _
    hPrinter As LongPtr) As Long
Declare PtrSafe Function EndPagePrinter Lib "winspool.drv" (ByVal _
    hPrinter As LongPtr) As Long
Declare PtrSafe Function ClosePrinter Lib "winspool.drv" (ByVal _
    hPrinter As LongPtr) As Long
Declare PtrSafe Function WritePrinter Lib "winspool.drv" (ByVal _
    hPrinter As LongPtr, pBuf As Any, ByVal cdBuf As Long, _
    pcWritten As Long) As Long
Declare PtrSafe Function AbortPrinter Lib "winspool.drv" (ByVal _
    hPrinter As LongPtr) As Long
Declare PtrSafe Function GetLastError Lib "kernel32" () As Long


Public Function printRawData(sPrinterName As String, lData As String) As Boolean
  Dim bStatus As Boolean, hPrinter As LongPtr, dDocInfo As DOCINFO, lJob As Long, nWritten As Long

  ' Open a handle to the printer.
  bStatus = OpenPrinter(sPrinterName, hPrinter, 0)
  If bStatus Then
    ' Fill in the structure with info about this "document."
    dDocInfo.pDocName = "DemoPage"
    dDocInfo.pOutputFile = vbNullString
    dDocInfo.pDatatype = "RAW"

    ' Inform the spooler the document is beginning.
    lJob = StartDocPrinter(hPrinter, 1, dDocInfo) 'Returns 0 :(
    'Debug.Print hPrinter, sPrinterName, lJob, GetLastError()

    If lJob > 0 Then
        ' Start a page.
        bStatus = StartPagePrinter(hPrinter)
        If bStatus Then
            ' Send the data to the printer.
            bStatus = WritePrinter(hPrinter, ByVal lData, Len(lData), nWritten)
            EndPagePrinter (hPrinter)
        End If
        ' Inform the spooler that the document is ending.
        EndDocPrinter (hPrinter)
    End If
    ' Close the printer handle.
    ClosePrinter (hPrinter)
  End If

  ' Check to see if correct number of bytes were written.
  If Not bStatus Or (nWritten <> Len(lData)) Then
    printRawData = False
  Else
    printRawData = True
  End If
End Function
 
Sub btn1_Click() 
'Only support windows 1252 or single byte encoding 
Dim printData As String 
printData = "^XA^FO50,60^A0N,20,20^FD" & Sheet1.Cells(2, 1) & "^FS^XZ" 

Call printRawData("ZDesigner ZR328 (CPCL)", printData) 
End Sub

注意如果您需要打印亚洲语言，请使用以下示例将编码转换为 UTF-8 并使用 CI28 发送ZPL （设置 UTF-8 编码）。    

Function UTF8EncodeURI(szInput)
    Dim wch, uch, szRet
    Dim x
    Dim nAsc, nAsc2, nAsc3
    If szInput = "" Then
        UTF8EncodeURI = szInput
        Exit Function
    End If
    For x = 1 To Len(szInput)
        wch = Mid(szInput, x, 1)
        nAsc = AscW(wch)
        If nAsc < 0 Then nAsc = nAsc + 65536
        If (nAsc And &HFF80) = 0 Then
            szRet = szRet & wch
        Else
            If (nAsc And &HF000) = 0 Then
           uch = "_" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & "_" & Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            Else
                uch = "_" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "_" & _
                      Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "_" & _
                      Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            End If
        End If
    Next
    UTF8EncodeURI = szRet
End Function

‘print with UTF-8 encoding
Sub  btn2_Click()
Dim printData As String
printData = "^XA^CW1,E:SIMSUN.TTF^CI28^FO50,60^A1N,20,20^FH_^FD" & UTF8EncodeURI(Sheet1.Cells(2, 1)) & "^FS^XZ"
Call printRawData("ZDesigner ZD620-203dpi ZPL", printData)
End Sub