OnAction运行时错误“1004”在初始运行
背景：我有一个logging奥运举重/历史的练习册。 用户可以通过按下一个调用macros“New_Lift”和“Create_Button”的button（Add New Lift）来创build新的电梯。 这将创build一个带有升降机名称的新工作表，使用升降机的名称在主工作表上创build一个新的列，添加一个名为“日志历史logging”（OnAction = new worksheet sub）的button（主表单）。
新的工作表，列和button创build正常，但在macros打开工作簿（以后工作正常）后第一次运行macros收到运行时错误“1004”。 错误指向button的“.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 (ie 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编辑器打开。
这是因为在Sheets.Add(...新工作表成为活动，并在CreateButton()一次声明：
With ActiveSheet 'Main Sheet
实际上是引用新添加的工作表，而不是像您期望的那样“主”工作表
底线， ActiveXXX避免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 (ie: "Main") sheet and make it active again 'Calls the CreateButton subroutine and passes the NewLift from user, last empty column and SheetCodeName (ie 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
我谨慎地select离开那里：
.Activate '<--| jump back to referenced (ie: "Main") sheet and make it active again
因为我打算你需要将“主”表作为活动用户
所以我也利用它将CreateButton（）中的ActiveSheet引用隐式引用到“主”表而不是改变Sub 签名添加一个新的参数（对“主”表或其名称的引用）使用和引用“主”表也