VBA条码标签打印代码求助：非数字后缀无法打印

DevOps 小满

2026-6-14

问题

本人是宏编程新手，现有一段用于打印A4尺寸条码标签的VBA代码，当标签后缀为数字（如DA-01-02、DA-01-10）时可正常打印，但后缀为非数字（如DA-01-AA、DA-01-BA）时无法打印，请求帮忙排查并修正错误。

原代码如下：

Private Sub CommandButton1_Click()

a = MsgBox("Are you sure you want to print labels?", vbYesNo + vbQuestion, "Attention!")
If a = 7 Then GoTo 10


Set start1 = ActiveSheet.Cells(7, 112)
Set start2 = ActiveSheet.Cells(7, 113)
Set start3 = ActiveSheet.Cells(7, 114)
Set start4 = ActiveSheet.Cells(7, 115)
Set end1 = ActiveSheet.Cells(10, 112)
Set end2 = ActiveSheet.Cells(10, 113)
Set end3 = ActiveSheet.Cells(10, 114)
Set end4 = ActiveSheet.Cells(10, 115)
 
tog = 0
For r = 2 To 38
    If Mid(ActiveSheet.Cells(5, 114), 1, 1) = ActiveSheet.Cells(20, r) Then tog = 1
Next r
    If tog = 0 Then a = MsgBox("Invalid Aisle", vbCritical, "Error!")
    If tog = 0 Then GoTo 10

tog = 0
For s = 2 To 38
    If Right(ActiveSheet.Cells(5, 114), 1) = ActiveSheet.Cells(20, s) Then tog = 1
Next s
    If tog = 0 Then a = MsgBox("Invalid Aisle", vbCritical, "Error!")
    If tog = 0 Then GoTo 10
 
For r = 112 To 115
    tog = 0
    
    
    If ActiveSheet.Cells(7, r).Value = 0 Or ActiveSheet.Cells(7, r) = 1 Or ActiveSheet.Cells(7, r) = 2 Or ActiveSheet.Cells(7, r) = 3 Or ActiveSheet.Cells(7, r) = 4 Or ActiveSheet.Cells(7, r) = 5 Or ActiveSheet.Cells(7, r) = 6 Or ActiveSheet.Cells(7, r) = 7 Or ActiveSheet.Cells(7, r) = 8 Or ActiveSheet.Cells(7, r) = 9 Then tog = 1
    If tog = 1 Then a = MsgBox("Value exceeds range, negative value, non-integer value or non-numerical character in start range", vbCritical, "Error!")
    If tog = 0 Then GoTo 10
Next r

For r = 112 To 115
    tog = 1
    If ActiveSheet.Cells(10, r).Value = 0 Or ActiveSheet.Cells(10, r) = 1 Or ActiveSheet.Cells(10, r) = 2 Or ActiveSheet.Cells(10, r) = 3 Or ActiveSheet.Cells(10, r) = 4 Or ActiveSheet.Cells(10, r) = 5 Or ActiveSheet.Cells(10, r) = 6 Or ActiveSheet.Cells(10, r) = 7 Or ActiveSheet.Cells(10, r) = 8 Or ActiveSheet.Cells(10, r) = 9 Then tog = 0
    If tog = 1 Then a = MsgBox("Value exceeds range, negative value, non-integer value or non-numerical character in end range", vbCritical, "Error!")
    If tog = 1 Then GoTo 10
Next r

If ((start4) + (start3 * 10) + (start2 * 100) + (start1 * 1000)) > ((end4) + (end3 * 10) + (end2 * 100) + (end1 * 1000)) Then tog = 2
If tog = 2 Then a = MsgBox("End range smaller than start range", vbCritical, "Error!")
If tog = 2 Then GoTo 10

If (((end4) + (end3 * 10) + (end2 * 100) + (end1 * 1000)) - ((start4) + (start3 * 10) + (start2 * 100) + (start1 * 1000))) > 49 Then tog = 3
If tog = 3 Then a = MsgBox("Range Exceeds 50 Labels", vbCritical, "Error!")
If tog = 3 Then GoTo 10

start4 = start4 - 1
Var = start4
ange = ActiveSheet.Cells(1, 2)

For i = Var To ange
    Sheets("Front Page").Select
       start4 = start4 + 1
       If start4 > 9 Then
       start3 = start3 + 1
       start4 = 0
       End If
       If start3 > 9 Then
       start2 = start2 + 1
       start3 = 0
       End If
       If start2 > 9 Then
       start1 = start1 + 1
       start2 = 0
       End If
       
 ActiveSheet.Cells(12, 110).Value = start1
 ActiveSheet.Cells(12, 111).Value = start2
 ActiveSheet.Cells(12, 112).Value2 = start3
 ActiveSheet.Cells(12, 113).Value2 = start4
 
       start4 = start4 + 1
       If start4 > 9 Then
       start3 = start3 + 1
       start4 = 0
       End If
       If start3 > 9 Then
       start2 = start2 + 1
       start3 = 0
       End If
       If start2 > 9 Then
       start1 = start1 + 1
       start2 = 0
       End If
       
 ActiveSheet.Cells(13, 110).Value = start1
 ActiveSheet.Cells(13, 111).Value = start2
 ActiveSheet.Cells(13, 112).Value2 = start3
 ActiveSheet.Cells(13, 113).Value2 = start4
 
If ((start4) + (start3 * 10) + (start2 * 100) + (start1 * 1000)) > ActiveSheet.Cells(1, 2) Then tog = 4
If tog = 4 Then GoTo 10
 
 Sheets("Print Page").Select
    ActiveSheet.Range("A1:CY7").Select
    Selection.PrintOut Copies:=1, Collate:=True
    
Next i

10
Sheets("Front Page").Select

End Sub

错误原因分析

强制数字校验拦截非数字输入：代码对起始/结束范围的单元格（列112-115）做了硬编码的0-9数字校验，只要内容不是单个数字就会触发错误并终止流程，这是导致非数字后缀无法打印的核心原因。
数值运算逻辑不支持字符：代码通过数值加法拼接标签后缀（start4 + start3*10 + start2*100 + start1*1000），非数字字符无法参与这类运算，会直接引发类型错误。
递增逻辑仅适配数字进位：循环里的start4>9等判断是针对数字的进位规则设计的，字母字符无法用这种方式实现递增（比如A→B、Z→AA）。

修正后的代码

以下代码修改了输入校验、范围判断和标签递增逻辑，支持数字+字母混合的后缀格式：

Private Sub CommandButton1_Click()
    Dim a As Integer
    a = MsgBox("确定要打印标签吗？", vbYesNo + vbQuestion, "注意！")
    If a = vbNo Then GoTo ExitSub

    ' 读取起始和结束后缀的四个字符（按字符串处理）
    Dim startStr As String, endStr As String
    startStr = UCase(ActiveSheet.Cells(7, 112).Value & ActiveSheet.Cells(7, 113).Value & _
                    ActiveSheet.Cells(7, 114).Value & ActiveSheet.Cells(7, 115).Value)
    endStr = UCase(ActiveSheet.Cells(10, 112).Value & ActiveSheet.Cells(10, 113).Value & _
                    ActiveSheet.Cells(10, 114).Value & ActiveSheet.Cells(10, 115).Value)

    ' 通道校验（保留原逻辑）
    Dim tog As Integer
    tog = 0
    For r = 2 To 38
        If Mid(ActiveSheet.Cells(5, 114), 1, 1) = ActiveSheet.Cells(20, r) Then tog = 1
    Next r
    If tog = 0 Then
        MsgBox("无效通道", vbCritical, "错误！")
        GoTo ExitSub
    End If

    tog = 0
    For s = 2 To 38
        If Right(ActiveSheet.Cells(5, 114), 1) = ActiveSheet.Cells(20, s) Then tog = 1
    Next s
    If tog = 0 Then
        MsgBox("无效通道", vbCritical, "错误！")
        GoTo ExitSub
    End If

    ' 范围合法性校验
    If StrComp(startStr, endStr, vbTextCompare) > 0 Then
        MsgBox("结束范围小于起始范围", vbCritical, "错误！")
        GoTo ExitSub
    End If

    ' 计算标签数量（支持字符范围计数）
    Dim labelCount As Integer
    labelCount = GetStringRangeCount(startStr, endStr)
    If labelCount > 50 Then
        MsgBox("标签数量超过50个", vbCritical, "错误！")
        GoTo ExitSub
    End If

    Dim currentStr As String
    currentStr = startStr
    Dim printCount As Integer
    printCount = 0

    ' 循环打印标签
    Do While StrComp(currentStr, endStr, vbTextCompare) <= 0 And printCount < 50
        Sheets("Front Page").Select
        
        ' 拆分当前字符串到对应单元格
        ActiveSheet.Cells(12, 110).Value = Mid(currentStr, 1, 1)
        ActiveSheet.Cells(12, 111).Value = Mid(currentStr, 2, 1)
        ActiveSheet.Cells(12, 112).Value = Mid(currentStr, 3, 1)
        ActiveSheet.Cells(12, 113).Value = Mid(currentStr, 4, 1)
        
        ' 获取下一个标签后缀
        currentStr = GetNextString(currentStr)
        
        ' 拆分第二个标签到对应单元格
        ActiveSheet.Cells(13, 110).Value = Mid(currentStr, 1, 1)
        ActiveSheet.Cells(13, 111).Value = Mid(currentStr, 2, 1)
        ActiveSheet.Cells(13, 112).Value = Mid(currentStr, 3, 1)
        ActiveSheet.Cells(13, 113).Value = Mid(currentStr, 4, 1)
        
        ' 打印当前页
        Sheets("Print Page").Select
        ActiveSheet.Range("A1:CY7").PrintOut Copies:=1, Collate:=True
        
        printCount = printCount + 2
        ' 如果下一个超过结束范围，停止循环
        If StrComp(currentStr, endStr, vbTextCompare) > 0 Then Exit Do
        currentStr = GetNextString(currentStr)
    Loop

ExitSub:
    Sheets("Front Page").Select
End Sub

' 生成下一个字符串（支持字母+数字递增，比如A→B，Z→AA，9→A，A9→B0）
Private Function GetNextString(inputStr As String) As String
    Dim i As Integer
    Dim charCode As Integer
    inputStr = UCase(inputStr)
    
    For i = Len(inputStr) To 1 Step -1
        charCode = Asc(Mid(inputStr, i, 1))
        ' 处理数字
        If charCode >= Asc("0") And charCode <= Asc("9") Then
            If charCode < Asc("9") Then
                Mid(inputStr, i, 1) = Chr(charCode + 1)
                Exit For
            Else
                Mid(inputStr, i, 1) = "A"
                ' 如果是第一位且需要进位，补A
                If i = 1 Then inputStr = "A" & inputStr
            End If
        ' 处理字母
        ElseIf charCode >= Asc("A") And charCode <= Asc("Z") Then
            If charCode < Asc("Z") Then
                Mid(inputStr, i, 1) = Chr(charCode + 1)
                Exit For
            Else
                Mid(inputStr, i, 1) = "0"
                ' 如果是第一位且需要进位，补A
                If i = 1 Then inputStr = "A" & inputStr
            End If
        End If
    Next i
    GetNextString = inputStr
End Function

' 计算两个字符串之间的标签数量（支持字母数字混合）
Private Function GetStringRangeCount(startStr As String, endStr As String) As Integer
    Dim count As Integer
    count = 0
    Dim currentStr As String
    currentStr = startStr
    
    Do While StrComp(currentStr, endStr, vbTextCompare) <= 0
        count = count + 1
        currentStr = GetNextString(currentStr)
    Loop
    GetStringRangeCount = count
End Function

关键修改说明

改用字符串处理后缀：把四个单元格的内容拼接成完整的后缀字符串，不再做数字校验，支持字母+数字混合格式。
新增字符递增函数：GetNextString函数实现了类似Excel列名的递增规则，支持数字0-9、字母A-Z的循环进位（比如9→A，Z→AA，A9→B0）。
字符串范围判断：用StrComp函数比较字符串大小，替代原来的数值运算判断。
标签数量计算：GetStringRangeCount函数遍历计算起始到结束的标签总数，确保不超过50个的限制。

内容的提问来源于stack exchange，提问作者P ferns

VBA条码标签打印代码求助：非数字后缀无法打印

错误原因分析 #

修正后的代码 #

关键修改说明 #

错误原因分析

修正后的代码

关键修改说明