Excel VBA打印脚本迁移后出现运行时错误'91'求助

问题描述 #

将个人电脑上可正常运行的Brother打印机标签打印Excel VBA项目迁移至工作电脑后，持续触发运行时错误'91'：对象变量或With块变量未设置，导致无法执行打印操作，但单步调试时本地窗口未发现异常。

相关代码 #

Dim CreateLabel As VbMsgBoxResult
Dim labelInfo As String
Dim sPath As String
Dim ObjDoc As Object

' Step 1: Ask the user if they wish to create a label
CreateLabel = MsgBox("Do you wish to create a label?", vbYesNo)

If CreateLabel = vbYes Then

    ' Step 2: Prompt for each parameter
    Dim licensePlate As String
    Dim partNumber As String
    Dim Description As String
    Dim expirationDate As String
    
    Dim validInput As Boolean
    Dim userInput As String
    
    ' Step 2a: Enter SupplierPlateID with exit option
    'Do
        'userInput = InputBox("Enter SupplierPlateID" & vbNewLine & _
                             "Press 'Cancel' to terminate the process.")
        'If userInput = "" Then Exit Sub
        'licensePlate = userInput
        licensePlate = InputBox("Enter License Plate:")
        'validInput = ValidateSupplierPlateID(licensePlate)
        'If Not validInput Then
         '   MsgBox "Invalid SupplierPlateID."
        'End If
    'Loop While Not validInput

    ' Step 2b: Enter Part Number with exit option
    Do
        userInput = InputBox("Enter Part Number (must have two '-' and end with '-875')" & vbNewLine & _
                             "Press 'Cancel' to terminate the process.")
        If userInput = "" Then Exit Sub
        partNumber = userInput
        validInput = ValidatePartNumber(partNumber)
        If Not validInput Then
            MsgBox "Invalid Part Number. It must have two '-' and end with '-875'."
        End If
    Loop While Not validInput

    Description = InputBox("Enter Description:")

    ' Step 2c: Enter Expiration Date with exit option
   expirationDate = InputBox("Enter Experation Date (YYYY-MM-DD)" & vbNewLine & _
                            "Press 'Cancel' to terminate the process.")

    ' Step 3: Validate and display entered information
    labelInfo = licensePlate & " | " & partNumber & " | " & Description & " | " & expirationDate
    confirmMsg = "Is the following information correct?" & vbCrLf & vbCrLf & labelInfo
    confirmed = MsgBox(confirmMsg, vbYesNo) = vbYes
    
    
    'Update the label's caption with the user-created string in the Userform
    UserForm1.Label3.Caption = labelInfo
    

    ' Step 4: Allow correction or confirmation
    If Not confirmed Then
        ' Provide an option to go through the steps again if the information was incorrect
        Call CreateAndPrintLabel
        Exit Sub
    End If
    
    ' Store labelInfo in cell B12 on Sheet1
    ThisWorkbook.Sheets("Sheet1").Range("B12").Value = labelInfo
    
    
    
     ' Step 5: Confirm if user wants to print
        printLabel = MsgBox("Do you wish to print the label?", vbYesNo)

            
            If printLabel = vbNo Then
                Exit Sub ' Exit the macro if user selects "No" for printing
            End If
        
        ' Step 5.5: Print the label using Brother printer
        Set ObjDoc = CreateObject("bpac.Document")
        sPath = "C:\Users\55455.buff\Documents\My Labels\Matrix.lbx"
        
        
        
        ' Open lbx file
        If ObjDoc.Open(sPath) Then
            ' Set text for the entire label
            ObjDoc.SetText 0, dataMatrixContent
            
            ObjDoc.GetObject("dataMatrix").text = labelInfo
            
            ' Print the label
            ObjDoc.StartPrint "", bpoDefault
            ObjDoc.PrintOut 1, bpoDefault
            ObjDoc.EndPrint
            
            ' Close lbx file
            ObjDoc.Close
        Else
            MsgBox "Failed to open label file."
        End If
    Else
        MsgBox "ActiveX Data Matrix control not found on the sheet."
    End If
'End If
End Sub
Function ValidatePartNumber(partNumber As String) As Boolean
    If CountCharacter(partNumber, "-") = 2 And Right(partNumber, 4) = "-875" Then
        ValidatePartNumber = True
    Else
        ValidatePartNumber = False
    End If
End Function

Function CountCharacter(ByVal text As String, ByVal character As String) As Long
    CountCharacter = (Len(text) - Len(Replace(text, character, ""))) / Len(character)
End Function

Function IsValidExpirationDate(expirationDate As String) As Boolean
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "^\d{4}-\d{2}-\d{2}$"
    
    If regex.Test(expirationDate) Then
        Dim currentDate As Date
        currentDate = Date
        Dim futureDate As Date
        futureDate = DateAdd("yyyy", 6, currentDate)
        
        If DateValue(expirationDate) <= futureDate Then
            IsValidExpirationDate = True
        End If
    End If
End Function

Function ValidateSupplierPlateID(supplierPlateID As String) As Boolean
    If Len(supplierPlateID) = 8 And Left(supplierPlateID, 2) = "PC" Then
        ValidateSupplierPlateID = True
    Else
        ValidateSupplierPlateID = False
    End If
End Function

Sub Print_Label()
    Dim bRet As Boolean
    Dim sPath As String
    Dim ObjDoc As bpac.Document
    Set ObjDoc = CreateObject("bpac.Document")
    sPath = "C:\Users\giovanni.fontanetta\Documents\My Labels\Matrix.lbx"
    
    'Open lbx file
    bRet = ObjDoc.Open(sPath)
    If (bRet <> False) Then

        ' Start Print-Setting
        ObjDoc.StartPrint "", bpoDefault

        ' Ask the user how many copies to print
        Dim numCopies As Integer
        numCopies = InputBox("Enter the number of copies to print:", "Number of Copies", 1)

        For i = 1 To numCopies
            ObjDoc.PrintOut 1, bpoDefault
        Next i

        ' Finish Print-Setting and start the printing
        ObjDoc.EndPrint

        ' Close lbx file
        ObjDoc.Close
    End If
End Sub

排查与解决步骤 #

错误'91'的核心是对象未被正确初始化或引用，结合迁移场景，按以下顺序排查：

1. 检查Brother标签打印组件（bpac）是否安装
   工作电脑必须安装Brother的P-touch Editor或bpac SDK，否则CreateObject("bpac.Document")无法创建对象。安装后重启Excel，再测试代码。

2. 修正硬编码的标签文件路径
   代码中sPath使用了个人电脑的用户目录路径（如C:\Users\55455.buff\...），工作电脑用户目录不同会导致文件找不到。建议改成动态获取路径：

   ' 让用户选择标签文件
   sPath = Application.GetOpenFilename("Brother Label Files (*.lbx), *.lbx")
   If sPath = "False" Then Exit Sub ' 用户取消选择则退出
   

3. 添加对象初始化失败的判断
   若bpac组件未注册，Set ObjDoc = CreateObject("bpac.Document")会返回Nothing，后续调用方法会触发错误。添加判断：

   Set ObjDoc = CreateObject("bpac.Document")
   If ObjDoc Is Nothing Then
       MsgBox "无法创建bpac对象，请检查Brother标签打印组件是否安装"
       Exit Sub
   End If
   

4. 强制变量声明避免隐式错误
   在模块开头添加Option Explicit，强制所有变量必须声明，避免printLabel、dataMatrixContent等未声明变量导致的意外空值。

5. 确认UserForm与控件存在
   检查工作电脑上的Excel是否已导入UserForm1，且表单中存在Label3控件，确保UserForm1.Label3.Caption = labelInfo能正常执行。

修正后的关键代码片段 #

Option Explicit ' 模块开头添加，强制变量声明

Sub CreateAndPrintLabel()
    Dim CreateLabel As VbMsgBoxResult
    Dim labelInfo As String
    Dim sPath As String
    Dim ObjDoc As Object
    Dim printLabel As VbMsgBoxResult ' 声明变量
    Dim confirmMsg As String ' 声明变量
    Dim confirmed As Boolean ' 声明变量
    Dim dataMatrixContent As String ' 声明变量，需赋值或确认来源
    
    ' ... 其他代码省略 ...
    
    ' Step 5.5: Print the label using Brother printer
    Set ObjDoc = CreateObject("bpac.Document")
    If ObjDoc Is Nothing Then
        MsgBox "无法创建bpac对象，请检查Brother标签打印组件是否安装"
        Exit Sub
    End If
    
    ' 动态获取标签文件路径
    sPath = Application.GetOpenFilename("Brother Label Files (*.lbx), *.lbx")
    If sPath = "False" Then Exit Sub
    
    ' Open lbx file
    If ObjDoc.Open(sPath) Then
        ' 确保dataMatrixContent已赋值
        dataMatrixContent = labelInfo ' 根据实际需求调整
        ObjDoc.SetText 0, dataMatrixContent
        
        Dim dataMatrixObj As Object
        Set dataMatrixObj = ObjDoc.GetObject("dataMatrix")
        If Not dataMatrixObj Is Nothing Then ' 检查对象是否存在
            dataMatrixObj.text = labelInfo
        Else
            MsgBox "标签文件中未找到dataMatrix对象"
        End If
        
        ' Print the label
        ObjDoc.StartPrint "", bpoDefault
        ObjDoc.PrintOut 1, bpoDefault
        ObjDoc.EndPrint
        
        ' Close lbx file
        ObjDoc.Close
    Else
        MsgBox "Failed to open label file."
    End If
End Sub

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