用户窗体出现Run-Time Error，请求VBA代码审核

问题背景 #

我有一段关联Excel用户窗体的VBA代码，窗体包含以下元素：

• 可自动填充的文本框：填写第一个文本框时，会从工作簿的隐藏工作表自动填充另外两个文本框
• 可自动获取Windows用户名的ComboBox
  代码最终目标是将文本框填充后的两张工作表进行双面打印（一张纸正反两面各打印一页）。这段代码偶尔会触发运行时错误，出错位置在ThisWorkbook.Sheets(Array("Devoluções de produto", "Vasilhame")).Select这一行。

原代码 #

Private Sub comimprimirvas_prod_Click()
Dim irow As Long
Dim ws As Worksheet
Dim lvalue
lvalue = Now

Set ws = ThisWorkbook.Worksheets("Base Dados Vasilhame")

irow = ws.Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).Row
With ws
.Range("A" & irow) = txtclienteopl.Value
.Range("B" & irow) = txtdevolução.Value
.Range("C" & irow) = txtlocaldecarga.Value
.Range("D" & irow) = txtmatricula2.Value
.Range("E" & irow) = txtpistacais.Value
.Range("F" & irow) = txtnºdevolução.Value
.Range("G" & irow) = txtundbarril.Value
.Range("H" & irow) = txtundgrade.Value
.Range("I" & irow) = lvalue

End With

'''''''''''''''''This inserts the username'''''''''''''''''''

Me.ComboBox1.Text = Environ$("Username")

ComboBox1.AddItem "André Lopes"
ComboBox1.AddItem "BackOffice"
ComboBox1.AddItem "Carlos Silva"
ComboBox1.AddItem "Flavio Gonçalves"
ComboBox1.AddItem "Nuno Prada"
ComboBox1.AddItem "Rita Vieira"
ComboBox1.AddItem "Zaida Sousa"
ComboBox1.AddItem ""

txtdevolução.SetFocus


''''''''''''''''This fills sheet Vasilhame''''''''''''''''''

With ThisWorkbook.Sheets("Vasilhame")

.Visible = True
    .Range("AJ7:AL7") = txtclienteopl.Value
    .Range("AJ14:AL14") = txtdevolução
    .Range("AJ9:AL9") = txtlocaldecarga
    .Range("AJ12:AL12") = txtmatricula2
    .Range("AJ16:AL16") = txtpistacais
    .Range("AJ19:AL19") = txtnºdevolução
    .Range("AL21") = txtundbarril
    .Range("AL22") = txtundgrade

End With


''''This fills sheet Devolução de produto'''''''''''''

With ThisWorkbook.Sheets("Devoluções de produto")

.Visible = True
    .Range("AR9:AY9") = txtnºdevolução.Value
    .Range("AR12:AY12") = txtclienteopl
    .Range("AR15:AY15") = txtmatricula2
    .Range("AR18:AY18") = txtpistacais


End With


With ThisWorkbook.Sheets(Array("Devoluções de produto", "Vasilhame"))



ThisWorkbook.Sheets(Array("Devoluções de produto", "Vasilhame")).Select

.PrintOut


ThisWorkbook.Sheets("Devoluções de produto").Range("AR9:AY9").ClearContents
ThisWorkbook.Sheets("Devoluções de produto").Range("AR12:AY12").ClearContents
ThisWorkbook.Sheets("Devoluções de produto").Range("AR15:AY15").ClearContents
ThisWorkbook.Sheets("Devoluções de produto").Range("AR18:AY18").ClearContents
ThisWorkbook.Sheets("Vasilhame").Range("AJ7:AL7").ClearContents
ThisWorkbook.Sheets("Vasilhame").Range("AJ9:AL9").ClearContents
ThisWorkbook.Sheets("Vasilhame").Range("AJ12:AL12").ClearContents
ThisWorkbook.Sheets("Vasilhame").Range("AJ14:AL14").ClearContents
ThisWorkbook.Sheets("Vasilhame").Range("AJ16:AL16").ClearContents
ThisWorkbook.Sheets("Vasilhame").Range("AJ19:AL19").ClearContents
ThisWorkbook.Sheets("Vasilhame").Range("AL21").ClearContents
ThisWorkbook.Sheets("Vasilhame").Range("AL22").ClearContents

txtnºdevolução = ""
txtclienteopl = ""
txtmatricula2 = ""
txtpistacais = ""
txtclienteopl = ""
txtdevolução = ""
txtlocaldecarga = ""
txtmatricula2 = ""
txtpistacais = ""
txtnºdevolução = ""
txtundbarril = ""
txtundgrade = ""

'''''''''''This changes the checkbox to X or blank'''''''''''''''''ThisWorkbook.Worksheets("Vasilhame").Range("AA2").Value = CheckBox1_PC.Value
CheckBox1_PC.Value = ""


    If CheckBox1_PC.Value = True Then
        ThisWorkbook.Worksheets("Vasilhame").Range("AA2").Value = "X"
    Else
        ThisWorkbook.Worksheets("Vasilhame").Range("AA2").Value = ""

    End If


''''''''''''''This changes the checkbox2 to X or blank''''''''''''''ThisWorkbook.Worksheets("Vasilhame").Range("AG6").Value = CheckBox2_PC.Value
CheckBox2_PC.Value = ""


    If CheckBox2_PC.Value = True Then
        ThisWorkbook.Worksheets("Vasilhame").Range("AG6").Value = "X"
    Else
        ThisWorkbook.Worksheets("Vasilhame").Range("AG6").Value = ""

    End If


ThisWorkbook.Worksheets("Vasilhame").Range("AC2:AG2").Value = ComboBox1.Value
ComboBox1.Value = ""

    If ComboBox1.Value = True Then
        ThisWorkbook.Worksheets("Vasilhame").Range("AC2:AG2").Value = ComboBox1.Value

    End If




.Visible = False

End With

end sub

错误触发位置 #

运行时错误偶尔出现在以下代码行：

ThisWorkbook.Sheets(Array("Devoluções de produto", "Vasilhame")).Select

问题分析与修复方案 #

1. 核心错误原因：不必要的Select操作 #

Select操作依赖Excel的活动窗口状态，当工作表可见性异常（比如被其他操作意外重置为隐藏），或者Excel窗口处于非激活状态时，执行Select就会报错。而且打印操作根本不需要选中工作表，直接对工作表集合调用.PrintOut即可。

2. 其他代码问题与优化点 #

• ComboBox项重复添加：每次点击按钮都执行AddItem，会导致下拉列表中出现大量重复项，应把这些代码移到用户窗体的Initialize事件中，只在窗体加载时添加一次。
• 文本框清空逻辑冗余：部分文本框被重复清空（如txtclienteopl、txtmatricula2），可以简化代码。
• 复选框处理逻辑混乱：先赋值再清空复选框，之后又判断空值的复选框状态，逻辑完全无效；而且复选框的值是布尔型，应该用False而非""来清空。
• ComboBox赋值逻辑错误：If ComboBox1.Value = True Then完全不合理，因为ComboBox的值是文本类型，直接赋值即可，不需要这个判断。
• 工作表可见性处理不严谨：最后对工作表集合设置.Visible = False可能失效，应分别设置每个工作表的可见性。

3. 修改后的代码 #

Private Sub comimprimirvas_prod_Click()
    Dim irow As Long
    Dim ws As Worksheet
    Dim lvalue As Date
    Dim wsVasilhame As Worksheet
    Dim wsDevolucao As Worksheet
    
    lvalue = Now
    ' 初始化工作表对象，避免重复调用
    Set ws = ThisWorkbook.Worksheets("Base Dados Vasilhame")
    Set wsVasilhame = ThisWorkbook.Sheets("Vasilhame")
    Set wsDevolucao = ThisWorkbook.Sheets("Devoluções de produto")
    
    ' 写入数据到Base Dados Vasilhame
    irow = ws.Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).Row
    With ws
        .Range("A" & irow) = txtclienteopl.Value
        .Range("B" & irow) = txtdevolução.Value
        .Range("C" & irow) = txtlocaldecarga.Value
        .Range("D" & irow) = txtmatricula2.Value
        .Range("E" & irow) = txtpistacais.Value
        .Range("F" & irow) = txtnºdevolução.Value
        .Range("G" & irow) = txtundbarril.Value
        .Range("H" & irow) = txtundgrade.Value
        .Range("I" & irow) = lvalue
    End With
    
    ' 设置ComboBox用户名（AddItem逻辑已移到UserForm_Initialize）
    txtdevolução.SetFocus
    
    ' 填充Vasilhame工作表
    wsVasilhame.Visible = True
    With wsVasilhame
        .Range("AJ7:AL7") = txtclienteopl.Value
        .Range("AJ14:AL14") = txtdevolução.Value
        .Range("AJ9:AL9") = txtlocaldecarga.Value
        .Range("AJ12:AL12") = txtmatricula2.Value
        .Range("AJ16:AL16") = txtpistacais.Value
        .Range("AJ19:AL19") = txtnºdevolução.Value
        .Range("AL21") = txtundbarril.Value
        .Range("AL22") = txtundgrade.Value
        
        ' 处理复选框1
        .Range("AA2").Value = IIf(CheckBox1_PC.Value, "X", "")
        CheckBox1_PC.Value = False
        
        ' 处理复选框2
        .Range("AG6").Value = IIf(CheckBox2_PC.Value, "X", "")
        CheckBox2_PC.Value = False
        
        ' 处理ComboBox值
        .Range("AC2:AG2").Value = ComboBox1.Value
    End With
    
    ' 填充Devoluções de produto工作表
    wsDevolucao.Visible = True
    With wsDevolucao
        .Range("AR9:AY9") = txtnºdevolução.Value
        .Range("AR12:AY12") = txtclienteopl.Value
        .Range("AR15:AY15") = txtmatricula2.Value
        .Range("AR18:AY18") = txtpistacais.Value
    End With
    
    ' 直接打印两张工作表，无需Select
    ThisWorkbook.Sheets(Array("Devoluções de produto", "Vasilhame")).PrintOut
    
    ' 清空工作表内容
    With wsDevolucao
        .Range("AR9:AY9, AR12:AY12, AR15:AY15, AR18:AY18").ClearContents
        .Visible = False
    End With
    With wsVasilhame
        .Range("AJ7:AL7, AJ9:AL9, AJ12:AL12, AJ14:AL14, AJ16:AL16, AJ19:AL19, AL21, AL22").ClearContents
        .Visible = False
    End With
    
    ' 清空窗体控件
    txtnºdevolução.Value = ""
    txtclienteopl.Value = ""
    txtmatricula2.Value = ""
    txtpistacais.Value = ""
    txtdevolução.Value = ""
    txtlocaldecarga.Value = ""
    txtundbarril.Value = ""
    txtundgrade.Value = ""
    ComboBox1.Value = ""
End Sub

' 把ComboBox的AddItem移到窗体初始化事件
Private Sub UserForm_Initialize()
    With Me.ComboBox1
        .AddItem "André Lopes"
        .AddItem "BackOffice"
        .AddItem "Carlos Silva"
        .AddItem "Flavio Gonçalves"
        .AddItem "Nuno Prada"
        .AddItem "Rita Vieira"
        .AddItem "Zaida Sousa"
        .AddItem ""
        .Text = Environ$("Username") ' 初始化时直接设置用户名
    End With
End Sub

4. 额外建议 #

• 开启VBA的错误捕获，在代码开头添加On Error GoTo ErrorHandler，方便定位具体错误类型；
• 确保所有文本框赋值时都使用.Value属性（原代码中部分地方遗漏，比如.Range("AJ14:AL14") = txtdevolução）；
• 双面打印可以在.PrintOut中指定参数，比如PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False，具体参数根据打印机支持情况调整。

内容的提问来源于stack exchange，提问作者André Lopes