在同一图纸中的不同图纸上复制VBA代码

Question

我正试图在给定工作簿的所有工作表中运行相同的代码。我已经将工作簿中的第一个工作表分配给VBA代码，并用形状/按钮进行了格式化，并且已经制作了两份相同的工作表。但是，当复制时，我的VBA代码将无法在副本上工作，它只能在第一张图纸和原始图纸上工作。有什么方法可以循环代码在按钮/形状上运行吗。我不需要传输表格数据，它应该保留在每张表格中。VBA代码仅适用于表格标题和子选项卡。下面是我的代码。

Sub TabCase()
With Sheet1
Application.ScreenUpdating = False
.Shapes("CaseOn").Visible = msoCTrue
.Shapes("CaseOff").Visible = msoFalse
.Shapes("DemOn").Visible = msoFalse
.Shapes("DemOff").Visible = msoCTrue
.Shapes("RefOn").Visible = msoFalse
.Shapes("RefOff").Visible = msoCTrue
.Shapes("SDOHOn").Visible = msoFalse
.Shapes("SDOHOff").Visible = msoCTrue
.Range("B:K").EntireColumn.Hidden = False
.Range("M:AO").EntireColumn.Hidden = True
Application.ScreenUpdating = True
End With
End Sub
Sub TabDem()
With Sheet1
Application.ScreenUpdating = False
.Shapes("CaseOn").Visible = msoFalse
.Shapes("CaseOff").Visible = msoCTrue
.Shapes("DemOn").Visible = msoCTrue
.Shapes("DemOff").Visible = msoFalse
.Shapes("RefOn").Visible = msoFalse
.Shapes("RefOff").Visible = msoCTrue
.Shapes("SDOHOn").Visible = msoFalse
.Shapes("SDOHOff").Visible = msoCTrue
.Range("M:Y").EntireColumn.Hidden = False
.Range("B:K,AA:AO").EntireColumn.Hidden = True
Application.ScreenUpdating = True
End With
End Sub
Sub TabRef()
With Sheet1
Application.ScreenUpdating = False
.Shapes("CaseOn").Visible = msoFalse
.Shapes("CaseOff").Visible = msoCTrue
.Shapes("DemOn").Visible = msoFalse
.Shapes("DemOff").Visible = msoCTrue
.Shapes("RefOn").Visible = msoCTrue
.Shapes("RefOff").Visible = msoFalse
.Shapes("SDOHOn").Visible = msoFalse
.Shapes("SDOHOff").Visible = msoCTrue
.Range("AA:AE").EntireColumn.Hidden = False
.Range("B:Z,AF:AO").EntireColumn.Hidden = True
Application.ScreenUpdating = True
End With
End Sub
Sub TabSDOH()
With Sheet1
Application.ScreenUpdating = False
.Shapes("CaseOn").Visible = msoFalse
.Shapes("CaseOff").Visible = msoCTrue
.Shapes("DemOn").Visible = msoFalse
.Shapes("DemOff").Visible = msoCTrue
.Shapes("RefOn").Visible = msoFalse
.Shapes("RefOff").Visible = msoCTrue
.Shapes("SDOHOn").Visible = msoCTrue
.Shapes("SDOHOff").Visible = msoFalse
.Range("AG:AO").EntireColumn.Hidden = False
.Range("B:AF").EntireColumn.Hidden = True
Application.ScreenUpdating = True
End With
End Sub
Sub loopAcrossSheets()
temp = Array("County", "City", "CSV")
For Each SheetName In temp

Next
End Sub 

Answer 1

对每个方法进行返工，以获得Worksheet类型的参数-例如：

Sub TabCase(ws As Worksheet)
Application.ScreenUpdating = False
With ws
.Shapes("CaseOn").Visible = msoCTrue
.Shapes("CaseOff").Visible = msoFalse
.Shapes("DemOn").Visible = msoFalse
.Shapes("DemOff").Visible = msoCTrue
.Shapes("RefOn").Visible = msoFalse
.Shapes("RefOff").Visible = msoCTrue
.Shapes("SDOHOn").Visible = msoFalse
.Shapes("SDOHOff").Visible = msoCTrue
.Range("B:K").EntireColumn.Hidden = False
.Range("M:AO").EntireColumn.Hidden = True
End With
Application.ScreenUpdating = True
End Sub

然后不要像这样称呼它：

TabCase

你可以称之为，并将其作为参数传入工作表中

TabCase Sheet1 'or Sheet2, or ThisWorkbook.Sheets("NewSheet") etc