Question

我对VBA很新，我需要一段代码以同样的方式应用到我的工作簿中的某些工作表。

我需要应用代码的工作表的名称如下：

Analysis Flow Racking％Refill

分析Flow Racking 1选择

分析线橱柜％补充

分析线橱柜选择

分析PFB

分析橱柜％补充

分析Cupboards by Picks

Analysis Flow Racking 2 Picks

代码如下：我们非常感谢您提供的任何帮助。非常感谢

 Sub AddCheckBox()

 Application.ScreenUpdating = False

 Dim cell As Range

 DelCheckBox  'Do the delete macro
'or delete all checkboxes in the worksheet
' ActiveSheet.CheckBoxes.Delete
ActiveWindow.View = xlNormalView
lastRow = ActiveSheet.Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row

For Each cell In Range("A5:A" & lastRow)
With ActiveSheet.CheckBoxes.Add(cell.Left, _
cell.Top, cell.Width, cell.Height)
.LinkedCell = cell.Offset(, 8).Address(External:=True)
'.Interior.ColorIndex = 37   'or  xlNone or xlAutomatic
.Caption = ""
'.Border.Weight = xlThin
End With
Next

 With Range("A5:A" & lastRow)
.Rows.RowHeight = 15
Worksheets("Analysis Flow Racking % Refill ").CheckBoxes.Select
Selection.ShapeRange.Align msoAlignCenters, msoFalse
Selection.ShapeRange.IncrementLeft 50
Range("A10000").Select


End With
ActiveWindow.View = xlPageLayoutView
Application.ScreenUpdating = True
End Sub

Answer 1

试一试：

Sub Driver()
  Dim ws as Worksheet
  'Since your worksheet names are somewhat variable, 
  'I'd suggest passing an array of known names from a driver routine to your worker routine.
  For each ws in Worksheets(Array("Analysis Flow Racking % Refill", _
                                  "Analysis Flow Racking 1 Picks", _
                                  "Analysis Line Cupboards %Refill"))
                                  'continue with the rest of your worksheets here...
    AddCheckBox ws
  Next
  'If however, you're processing all the worksheets in the workbook, then this will be easier
  For each ws in ActiveWorkbook.Sheets
    AddCheckBox ws
  Next
End Sub

您现在需要修改AddCheckBox()例程以接受工作表作为参数：

Sub AddCheckBox(ByVal TheSheet as Worksheet)

  Application.ScreenUpdating = False
  DelCheckBox  'Do the delete macro
  'or delete all checkboxes in the worksheet
  ' ActiveSheet.CheckBoxes.Delete
  ActiveWindow.View = xlNormalView
  Dim LastRow as integer   'always declare your variables!
  lastRow = ActiveSheet.Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row

  Dim cell As Range
  For Each cell In TheSheet.Range("A5:A" & lastRow)
    With TheSheet.CheckBoxes.Add(cell.Left, _
                                 cell.Top, cell.Width, cell.Height)
      .LinkedCell = cell.Offset(, 8).Address(External:=True)
      '.Interior.ColorIndex = 37   'or  xlNone or xlAutomatic
      .Caption = ""
      '.Border.Weight = xlThin
    End With
  Next

  'Note: removed WITH from here - it only effected 1 row and was confusing    
  TheSheet.Range("A5:A" & lastRow).Rows.RowHeight = 15
  ''''''''''''''''''''''''''''''
  TheSheet.CheckBoxes.Select
  Selection.ShapeRange.Align msoAlignCenters, msoFalse
  Selection.ShapeRange.IncrementLeft 50
  Range("A10000").Select
  '
  'I believe that this code can be replaced with this:
  TheSheet.Checkboxes.ShapeRange.Align msoAlignCenters msoFalse
  TheSheet.Checkboxes.ShapeRange.IncrementLeft 50
  ''''''''''''''''''''''''''''''
  ActiveWindow.View = xlPageLayoutView
  Application.ScreenUpdating = True
End Sub

将相同代码的代码应用于同一工作簿中的多个工作表

1 个答案: