vba - 首次运行时出现 OnAction 运行时错误 "1004"

Question

背景:我有一本记录奥林匹克举重/历史的工作簿。用户可以通过按下调用宏“New_Lift”和“Create_Button”的按钮(添加新电梯)来创建新电梯。这将创建一个包含电梯名称的新工作表，在主工作表上创建一个包含电梯名称的新列，添加一个名为“日志历史记录”的按钮(主工作表)(OnAction = 新工作表子项)。

新工作表、列和按钮创建良好，但在打开工作簿后首次运行宏时收到运行时错误“1004”(此后工作正常)。该错误指向按钮的“.OnAction”。下面是主表和“Create_Button”代码的屏幕截图。非常感谢任何帮助，如果我需要澄清任何内容，请告诉我。

工作簿屏幕截图

Sub Add_New_Lift()

'*****************************************************************************************************
' This macro creates a new columns that contains the lift name, "Current", "Goal", "% Goal" and formulas
'*****************************************************************************************************
Dim ecol As Integer
Dim erow As Integer
Dim NewLift As String
Dim Lift_Metcon As String
Dim SheetCodeName As String

Application.ScreenUpdating = False

'Ask user to provide the name of the lift through a message box
NewLift = InputBox("New Lift Name:", "Add New Lift")

If StrPtr(NewLift) = 0 Then
    Exit Sub
Else
    Do
    Lift_Metcon = InputBox("Is this a Lift (Weight), Metcon (Time), or AMRAP (Total Reps):" & _
                    vbCrLf & vbTab & "-   Lift" & _
                    vbCrLf & vbTab & "-   Metcon" & _
                    vbCrLf & vbTab & "-   AMRAP" _
                    , "Type of Measurement")
        
    If StrPtr(Lift_Metcon) = 0 Then
        Exit Sub
    ElseIf (Lift_Metcon = "Lift") Or (Lift_Metcon = "Metcon") Or (Lift_Metcon = "AMRAP") Then
        Exit Do
    Else
        MsgBox "You have not made a valid entry.  Please try again."
    End If
    Loop
End If

'Find first empty column to add the new lift and formatting as well as Column letters for use with formula
ecol = Worksheets("Main").Cells(4, Columns.Count).End(xlToLeft).Offset(0, 1).Column
ColNo1 = ecol
ColLet1 = Split(Cells(, ColNo1).Address, "$")(1)
ColNo2 = ecol + 1
ColLet2 = Split(Cells(, ColNo2).Address, "$")(1)
ColNo3 = ecol + 2
ColLet3 = Split(Cells(, ColNo3).Address, "$")(1)


'Formatting
    Worksheets("Main").Activate
    Columns(ecol).Select
    Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
    Selection.Borders(xlEdgeLeft).Weight = xlMedium
    Range(Cells(3, ecol), Cells(3, ecol + 2)).Merge
    Cells(3, ecol) = NewLift
    Cells(3, ecol).Font.Size = 16
    Cells(4, ecol) = "Current"
    Cells(4, ecol + 1) = "Goal"
    Cells(4, ecol + 2) = "% Goal"
    Range(Cells(3, ecol), Cells(4, ecol + 2)).HorizontalAlignment = xlCenter
    Range(Cells(3, ecol), Cells(4, ecol + 2)).Font.Bold = True
    Range(Cells(3, ecol), Cells(4, ecol + 2)).ColumnWidth = 8
    Range(Cells(1, ecol), Cells(4, ecol + 2)).Interior.Color = RGB(166, 166, 166)
    Range(Cells(5, ecol + 2), Cells(100, ecol + 2)).Formula = "=IF(" & ColLet1 & "5<> """", " & ColLet1 & "5/" & ColLet2 & "5,"""" )"
    Range(Cells(5, ecol + 2), Cells(100, ecol + 2)).NumberFormat = "0.00%"
    
    If Lift_Metcon = "Metcon" Then
        Range(Cells(5, ecol), Cells(100, ecol)).NumberFormat = "0.0"
    End If

'Create new worksheet with formatting
Sheets.Add(After:=Sheets(Sheets.Count)).Name = NewLift
Sheets(NewLift).Range("A2") = "Name"
Sheets(NewLift).Range("A1") = Lift_Metcon
Sheets(NewLift).Range("A1").Font.Color = RGB(166, 166, 166)
Sheets(NewLift).Range("A2:B2").Font.Bold = True
Sheets(NewLift).Range("A:A").ColumnWidth = 27
Sheets(NewLift).Range("A1:BZ2").Interior.Color = RGB(166, 166, 166)
Sheets(NewLift).Range("A1").RowHeight = 55
Sheets(NewLift).Range("B2") = "M/F"
Sheets(NewLift).Columns("C").Select
ActiveWindow.FreezePanes = True
Sheets(NewLift).Range("A3").Select

For Each Cell In Range("A3:BZ100") ''change range accordingly
If Cell.Row Mod 2 = 1 Then ''highlights row 2,4,6 etc|= 0 highlights 1,3,5
    Cell.Interior.Color = RGB(217, 217, 217) ''color to preference
Else
    Cell.Interior.ColorIndex = xlNone ''color to preference or remove
End If
Next Cell

SheetCodeName = ActiveSheet.CodeName

'Calls the CreateButton subroutine and passes the NewLift from user, last empty column and SheetCodeName (i.e. Sheet5)
Call CreateButton(NewLift, ecol, SheetCodeName)

Worksheets("Records").Activate
erow = Worksheets("Records").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
Cells(erow, 1) = NewLift

Worksheets("Main").Activate
Range("A5").Select

Application.ScreenUpdating = True

End Sub



Sub CreateButton(NewLift As String, ecol As Integer, SheetCodeName As String)
Dim Code As String
Dim NewLiftSpace As String

NewLiftSpace = Replace(NewLift, " ", "_")
SheetCodeName = Worksheets(NewLift).CodeName

With ActiveSheet 'Main Sheet
    .Buttons.Add(Cells(2, ecol + 1).Left, Cells(2, ecol + 1).Top, 45, 45).Select
    Selection.Characters.Text = "Log" & vbCrLf & "History"
    Selection.OnAction = SheetCodeName & "." & NewLiftSpace & "_Button"
End With

'subroutine macro text
Code = "Public Sub " & NewLiftSpace & "_Button()" & vbCrLf
Code = Code & "Dim LiftSheet As String" & vbCrLf
Code = Code & "LiftSheet = " & """" & NewLift & """" & vbCrLf
Code = Code & "Call History.Log_History(LiftSheet)" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Public Sub CommandButton1_Click()" & vbCrLf
Code = Code & "UserForm1.Show" & vbCrLf
Code = Code & "Athlete_Chart(Athlete)" & vbCrLf
Code = Code & "End Sub"


'add macro at the end of the sheet module
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
    .InsertLines .CountOfLines + 1, Code
End With

End Sub

编辑:如果 VBA 编辑器打开，代码运行不会出现错误。

Answer 1

这是因为在 Sheets.Add(... 之后，新工作表变为 Active，并且一旦进入 CreateButton() 语句:

With ActiveSheet 'Main Sheet

实际上引用的是新添加的工作表，而不是您预期的“主”工作表

底线，尽可能避免 Activate/ActiveXXX/Select/Selection 编码模式并使用完全限定的范围引用，如以下代码重构所示:

Option Explicit

Sub Add_New_Lift()

    '*****************************************************************************************************
    ' This macro creates a new columns that contains the lift name, "Current", "Goal", "% Goal" and formulas
    '*****************************************************************************************************
    Dim ecol As Integer, ColNo1 As Integer, ColNo2 As Integer, ColNo3 As Integer
    Dim ColLet1 As String, ColLet2 As String, ColLet3 As String
    Dim erow As Integer
    Dim NewLift As String
    Dim Lift_Metcon As String
    Dim SheetCodeName As String
    Dim cell As Range

    Application.ScreenUpdating = False
    On Error GoTo errHandler
    'Ask user to provide the name of the lift through a message box
    NewLift = InputBox("New Lift Name:", "Add New Lift")

    If StrPtr(NewLift) = 0 Or NewLift = "" Then Exit Sub
    Do
        Lift_Metcon = InputBox("Is this a Lift (Weight), Metcon (Time), or AMRAP (Total Reps):" & _
                        vbCrLf & vbTab & "-   Lift" & _
                        vbCrLf & vbTab & "-   Metcon" & _
                        vbCrLf & vbTab & "-   AMRAP" _
                        , "Type of Measurement")
        If StrPtr(Lift_Metcon) = 0 Then Exit Sub
    Loop While Not ((Lift_Metcon = "Lift") Or (Lift_Metcon = "Metcon") Or (Lift_Metcon = "AMRAP"))

    'Find first empty column to add the new lift and formatting as well as Column letters for use with formula
    With Worksheets("Main") '<--| reference your "Main" sheet
        ecol = .Cells(4, Columns.Count).End(xlToLeft).Offset(0, 1).Column
        ColNo1 = ecol
        ColLet1 = Split(.Cells(, ColNo1).Address, "$")(1)
        ColNo2 = ecol + 1
        ColLet2 = Split(.Cells(, ColNo2).Address, "$")(1)
        ColNo3 = ecol + 2
        ColLet3 = Split(.Cells(, ColNo3).Address, "$")(1)

        'Formatting
        With .Columns(ecol) '<--| reference referenced sheet 'ecol'th column
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeLeft).Weight = xlMedium
        End With
        .Range(.Cells(3, ecol), .Cells(3, ecol + 2)).Merge
        .Cells(3, ecol) = NewLift
        .Cells(3, ecol).Font.Size = 16
        .Cells(4, ecol) = "Current"
        .Cells(4, ecol + 1) = "Goal"
        .Cells(4, ecol + 2) = "% Goal"
        .Range(.Cells(3, ecol), .Cells(4, ecol + 2)).HorizontalAlignment = xlCenter
        .Range(.Cells(3, ecol), .Cells(4, ecol + 2)).Font.Bold = True
        .Range(.Cells(3, ecol), .Cells(4, ecol + 2)).ColumnWidth = 8
        .Range(.Cells(1, ecol), .Cells(4, ecol + 2)).Interior.Color = RGB(166, 166, 166)
        .Range(.Cells(5, ecol + 2), .Cells(100, ecol + 2)).Formula = "=IF(" & ColLet1 & "5<> """", " & ColLet1 & "5/" & ColLet2 & "5,"""" )"
        .Range(.Cells(5, ecol + 2), .Cells(100, ecol + 2)).NumberFormat = "0.00%"
        If Lift_Metcon = "Metcon" Then .Range(.Cells(5, ecol), .Cells(100, ecol)).NumberFormat = "0.0"

        'Create new worksheet with formatting
        With Sheets.Add(After:=Sheets(Sheets.Count)) '<--| this will make the new sheet the "Active" one
            .Name = NewLift
            .Range("A2") = "Name"
            .Range("A1") = Lift_Metcon
            .Range("A1").Font.Color = RGB(166, 166, 166)
            .Range("A2:B2").Font.Bold = True
            .Range("A:A").ColumnWidth = 27
            .Range("A1:BZ2").Interior.Color = RGB(166, 166, 166)
            .Range("A1").RowHeight = 55
            .Range("B2") = "M/F"
            .Columns("C").Select
            ActiveWindow.FreezePanes = True

            For Each cell In .Range("A3:BZ100") ''change range accordingly
                If cell.Row Mod 2 = 1 Then ''highlights row 2,4,6 etc|= 0 highlights 1,3,5
                    cell.Interior.Color = RGB(217, 217, 217) ''color to preference
                Else
                    cell.Interior.ColorIndex = xlNone ''color to preference or remove
                End If
            Next cell
            SheetCodeName = .CodeName

        End With
        .Activate '<--| jump back to referenced (i.e.: "Main") sheet and make it active again

        'Calls the CreateButton subroutine and passes the NewLift from user, last empty column and SheetCodeName (i.e. Sheet5)
        CreateButton NewLift, ecol, SheetCodeName

    End With
    Worksheets("Records").Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = NewLift

errHandler:
    Application.ScreenUpdating = True

End Sub



Sub CreateButton(NewLift As String, ecol As Integer, SheetCodeName As String)
    Dim Code As String
    Dim NewLiftSpace As String

    NewLiftSpace = Replace(NewLift, " ", "_")
    SheetCodeName = Worksheets(NewLift).CodeName

    With ActiveSheet.Buttons.Add(Cells(2, ecol + 1).Left, Cells(2, ecol + 1).Top, 45, 45) '<--| reference a new button on active sheet
        .Characters.Text = "Log" & vbCrLf & "History"
        .OnAction = SheetCodeName & "." & NewLiftSpace & "_Button"
    End With

    'subroutine macro text
    Code = "Public Sub " & NewLiftSpace & "_Button()" & vbCrLf
    Code = Code & "Dim LiftSheet As String" & vbCrLf
    Code = Code & "LiftSheet = " & """" & NewLift & """" & vbCrLf
    Code = Code & "Call History.Log_History(LiftSheet)" & vbCrLf
    Code = Code & "End Sub" & vbCrLf
    Code = Code & "Public Sub CommandButton1_Click()" & vbCrLf
    Code = Code & "UserForm1.Show" & vbCrLf
    Code = Code & "Athlete_Chart(Athlete)" & vbCrLf
    Code = Code & "End Sub"

    'add macro at the end of the sheet module
    With ActiveWorkbook.VBProject.VBComponents(SheetCodeName).CodeModule '<--| reference your new sheet 'CodeName'
        .InsertLines .CountOfLines + 1, Code
    End With

End Sub

我特意选择离开:

.Activate '<--| jump back to referenced (i.e.: "Main") sheet and make it active again

因为我想让用户将“主”工作表保留为事件工作表

所以我还利用它在 CreateButton() 中保留 ActiveSheet 引用来隐式引用“Main”表，而不是更改 Sub signature 添加新参数(引用到“主”表或其名称)也可以使用和引用“主”表