excelVBA实现产线流水号同时打印标签

image.png

一个简单的界面
VBA代码如下

Option Explicit

'保存所有的打印机
Dim arr() As String

Private Sub CommandButton1_Click()

If TextBox1 = "" Or TextBox2 = "" Then
MsgBox "流水号不能为空"
    Exit Sub
End If

'记录条码内容
With Sheets("listnumber")
    Dim fng As Range
    Set fng = .Range("b:b").Find(TextBox1.Text, , , xlWhole)
    If Not fng Is Nothing Then
        MsgBox "该流水号已经存在"
        Exit Sub
    End If
    '----------------------------------------
    Dim rng As Range
    Set rng = .Cells(Rows.Count, 1).End(xlUp)
    rng.Offset(1, 0) = rng.Value + 1
    rng.Offset(1, 1) = TextBox1.Text
    rng.Offset(1, 2) = TextBox2.Text
End With

'调用打印过程
Call print_label(TextBox1.Text)


'条码的内容
TextBox1.Text = ""
TextBox1.SetFocus


End Sub




Private Sub UserForm_Activate()

TextBox2.Value = Format(Date, "yyyy-mm-dd")

'读取所有的打印机
Call allprinter

End Sub

'定义print过程
Sub print_label(rng As String)
    On Error Resume Next
    Dim i%
    Dim file_path
    Dim btapp As BarTender.Application
    Dim btformat As BarTender.Format
    Dim ws As Object
    Set ws = CreateObject("wscript.network")
    
    
    Set btapp = CreateObject("bartender.application")
    
    btapp.Visible = False
    
    '-------------------------------------循环打印label
    
    If UBound(arr) = LBound(arr) Then
        MsgBox "您暂未安装打印机"
        Exit Sub
    End If
    
    
    For i = LBound(arr) To UBound(arr)
         file_path = ThisWorkbook.Path & "\label\label" & i & ".btw"
        '设置打印条码
        Set btformat = btapp.Formats.Open(file_path)
        '将流水号设置到条码上
        btformat.SetNamedSubStringValue "ewm", rng
        '设置打印格式
        btformat.PrintSetup.IdenticalCopiesOfLabel = 1
        '设置默认的打印机
        ws.SetDefaultPrinter (arr(i))
        '打印文件
        btformat.PrintOut
        '关闭文件
        btformat.Close btDoNotSaveChanges
    Next
    '关闭程序
    btapp.Quit

End Sub


'取得所有的打印机保存在当前的数组中
Sub allprinter()
    Dim i&, ws As Object, st$, ptn$, n&
    Set ws = CreateObject("wscript.network")
    n = ws.EnumPrinterConnections.Count
    ReDim arr(1 To n / 2)
    For i = 1 To n - 1 Step 2
        ptn = ws.EnumPrinterConnections.Item(i)  '打印机名称
        arr((i - 1) / 2 + 1) = ptn
    Next
End Sub

注意事项：①listnumber表格需要自己建立，该表格的目的是为了保存刷入的流水号，防止重复。