初始运行时OnAction运行时错误“1004”

1 回答

• 1

  这是因为在 Sheets.Add(... 之后，新表格成为活动而且在 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
  

  我在哪里deliberatley选择离开：

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

  因为我打算你需要让用户使用“Main”表作为活动表

  所以我也利用它在CreateButton（）中留下 ActiveSheet 引用来隐式引用"Main"表而不是更改Sub签名添加新参数（对"Main"表或其名称的引用）以使用和引用"Main"表也

  回复于 2024-05-03T05:37:53+08:00