根据用户表单复选框值运行不同的宏

Question

一直在环顾四周，看看我是否能自己找到解决问题的方法，但我做不到......

基本上我正在创建一个用户表单，其中包含 4 个不同的复选框、[4] 个选项按钮和 1 个命令按钮。

第一帧 - Optionbutton5（从 B 列开始），OptionButton6（从 C 列开始）

第二帧 - Optionbutton7（选定的工作表），OptionButton8（所有工作表）

第三帧 - CheckBox1（封面），CheckBox2（Trans_Letter），CheckBox3（缩写）CheckBox3（索引）

此用户表单可帮助我更改活动表或工作簿中所有工作表的行宽和列宽 这个用户表单有 3 个框架：

第 1 帧：选择要更改列宽的列（B 或 C）。

第二帧：选择要在哪个工作表上更改行高和列宽（在活动工作表上或在所有工作表上）

第 3 帧：它有 4 个复选框，其中包含我的工作簿中 4 个工作表的名称。虽然我的工作簿中有近 50 张工作表，但我为这 4 张工作表创建了复选框，因为在需要时我可以选择任何复选框，并且在更改所有工作表的列宽和行高时排除该工作表。

我开发了宏来更改列（B 或 C）和 activesheet 以及所有工作表的列宽和行高，这些宏工作得很好。 直到现在我成功地连接了我的第一帧和第二帧（例如：当我在第一帧中选择“B 列向前”和第二帧中的“所有工作表”时，它正在改变列宽和行高。 现在我想链接我的第三帧，一旦我在第一帧中选择“Column B onwards”，在第二帧中选择“All Sheets”，在第三帧中选择“Cover”，那么它应该改变所有工作表的列宽和行高，除了工作表名称“Cover”。

您能否帮我编写代码，只要任何复选框为 TRUE，那么对于相应的工作表，宏不应该应用，即列和行的高度和宽度发生变化。

模块代码：

Sub rowcolactivesheetb()

Dim exworkb As Workbook
Dim xlwksht As Worksheet
Dim lastrow1 As Long
Dim lastcolumn1 As Long
Dim firstrowDB As Long

With ActiveSheet
    lastrow1 = .Cells(Rows.Count, "A").End(xlUp).Row
    lastcolumn1 = .Cells(1, Columns.Count).End(xlToLeft).Column
    .Range(.Cells(1, 2), .Cells(lastrow1, lastcolumn1)).Select
    Selection.Cells.RowHeight = 9.4
    Selection.Cells.ColumnWidth = 11.2
End With

End Sub

---

Sub rowcolallsheetb()

Dim exworkb As Workbook
Dim xlwksht As Worksheet
Dim lastrow1 As Long
Dim lastcolumn1 As Long
Dim firstrowDB As Long
Dim Z As Integer
Dim ShtNames() As String

ReDim ShtNames(1 To ActiveWorkbook.Sheets.Count)

For Z = 1 To ActiveWorkbook.Sheets.Count
    ShtNames(Z) = Sheets(Z).Name
    Sheets(Z).Activate
    lastrow1 = Sheets(Z).Cells(Rows.Count, "A").End(xlUp).Row
    lastcolumn1 = Sheets(Z).Cells(1, Columns.Count).End(xlToLeft).Column
    ActiveWorkbook.Sheets(Z).Range(Sheets(Z).Cells(1, 2), Sheets(Z).Cells(lastrow1, lastcolumn1)).Select
    Selection.Cells.RowHeight = 9.4
    Selection.Cells.ColumnWidth = 11.2
Next Z

End Sub

---

Sub rowcolactivesheetc()

Dim exworkb As Workbook
Dim xlwksht As Worksheet
Dim lastrow1 As Long
Dim lastcolumn1 As Long
Dim firstrowDB As Long

With ActiveSheet
    lastrow1 = .Cells(Rows.Count, "A").End(xlUp).Row
    lastcolumn1 = .Cells(1, Columns.Count).End(xlToLeft).Column
    .Range(.Cells(1, 3), .Cells(lastrow1, lastcolumn1)).Select
    Selection.Cells.RowHeight = 9.4
    Selection.Cells.ColumnWidth = 11.2
End With

End Sub

---

Sub rowcolactivesheetc()

Dim exworkb As Workbook
Dim xlwksht As Worksheet
Dim lastrow1 As Long
Dim lastcolumn1 As Long
Dim firstrowDB As Long

With ActiveSheet
    lastrow1 = .Cells(Rows.Count, "A").End(xlUp).Row
    lastcolumn1 = .Cells(1, Columns.Count).End(xlToLeft).Column
    .Range(.Cells(1, 3), .Cells(lastrow1, lastcolumn1)).Select
    Selection.Cells.RowHeight = 9.4
    Selection.Cells.ColumnWidth = 11.2
End With

End Sub

---

Sub rowcolallsheetc()

Dim exworkb As Workbook
Dim xlwksht As Worksheet
Dim lastrow1 As Long
Dim lastcolumn1 As Long
Dim firstrowDB As Long
Dim Z As Integer
Dim ShtNames() As String

ReDim ShtNames(1 To ActiveWorkbook.Sheets.Count)

For Z = 1 To Sheets.Count
    ShtNames(Z) = Sheets(Z).Name
    Sheets(Z).Select
    lastrow1 = Sheets(Z).Cells(Rows.Count, "A").End(xlUp).Row
    lastcolumn1 = Sheets(Z).Cells(1, Columns.Count).End(xlToLeft).Column
    ActiveWorkbook.Sheets(Z).Range(Sheets(Z).Cells(1, 3), Sheets(Z).Cells(lastrow1, lastcolumn1)).Select
    Selection.Cells.RowHeight = 9.4
    Selection.Cells.ColumnWidth = 11.2
Next Z

End Sub

---

Sub rowcolallsheetbcover()

Dim exworkb As Workbook
Dim xlwksht As Worksheet
Dim lastrow1 As Long
Dim lastcolumn1 As Long
Dim firstrowDB As Long
Dim Z As Integer
Dim ShtNames() As String

ReDim ShtNames(1 To ActiveWorkbook.Sheets.Count)

For Z = 1 To Sheets.Count
    ShtNames(Z) = Sheets(Z).Name
    If Sheets(Z).Name <> "Cover" Then
        Sheets(Z).Select
        lastrow1 = Sheets(Z).Cells(Rows.Count, "A").End(xlUp).Row
        lastcolumn1 = Sheets(Z).Cells(1, Columns.Count).End(xlToLeft).Column
        ActiveWorkbook.Sheets(Z).Range(Sheets(Z).Cells(1, 2), Sheets(Z).Cells(lastrow1, lastcolumn1)).Select
        Selection.Cells.RowHeight = 9.14
        Selection.Cells.ColumnWidth = 7.14
    End If
Next Z

End Sub

---

Private Sub CommandButton1_Click()

If Me.OptionButton5.Value = True Then
    If Me.OptionButton7.Value = True Then
        Call rowcolactivesheetb
    End If
End If

If Me.OptionButton6.Value = True Then
    If Me.OptionButton7.Value = True Then
        Call rowcolactivesheetc
    End If
End If

If Me.OptionButton5.Value = True Then
    If Me.OptionButton8.Value = True Then
        If Me.CheckBox1.Value = True Then
            Call rowcolallsheetbcover
        Else
            Call rowcolallsheetb
        End If
    End If
End If

If Me.OptionButton6.Value = True And _
    Me.OptionButton8.Value = True And _
    Me.CheckBox1.Value = False And _
    Me.CheckBox2.Value = False And _
    Me.CheckBox3.Value = False And _
    Me.CheckBox4.Value = False Then
        Call rowcolallsheetc
End If

If Me.OptionButton6.Value = True And _
    Me.OptionButton8.Value = True And _
    Me.CheckBox1.Value = True Then
        Call rowcolallsheetccover
End If

If Me.OptionButton6.Value = True And _
    Me.OptionButton8.Value = True And _
    Me.CheckBox2.Value = True Then
        Call rowcolallsheetctransletter
End If

End Sub

Answer 1

我想为您的问题提供一种更简洁的方法。这是您的CommandButton1_Click() 的修改代码：

Option Explicit

Private Sub CommandButton1_Click()

Dim startColumn As Long
Dim formatAllSheets As Boolean
Dim sheetsToExcludeList As String

startColumn = 3
If Me.OptionButton5.Value Then startColumn = 2

formatAllSheets = True
If Me.OptionButton7.Value Then formatAllSheets = False

If Me.CheckBox1.Value Then sheetsToExcludeList = sheetsToExcludeList & ",Cover"
If Me.CheckBox2.Value Then sheetsToExcludeList = sheetsToExcludeList & ",Trans_Letter"
If Me.CheckBox3.Value Then sheetsToExcludeList = sheetsToExcludeList & ",Abbreviations"
If Me.CheckBox4.Value Then sheetsToExcludeList = sheetsToExcludeList & ",Indexes"
sheetsToExcludeList = Mid(sheetsToExcludeList, 2)

Call FormatRowsAndColumns(formatAllSheets, startColumn, sheetsToExcludeList)

End Sub

这里是模块的调整（对上面的调用）代码：

Option Base 1
Option Explicit
Option Compare Text

Sub FormatRowsAndColumns(formatAllSheets As Boolean, startColumn As Long, sheetsToExcludeList As String)

Dim sheetNumber As Long
Dim sheetsToExcludeArray As Variant

If startColumn < 2 Or startColumn > 3 Then startColumn = 2
sheetsToExcludeArray = Split(sheetsToExcludeList, ",")

If formatAllSheets Then
    For sheetNumber = 1 To ThisWorkbook.Worksheets.Count
        If LBound(sheetsToExcludeArray) <= UBound(sheetsToExcludeArray) Then
            If IsError(WorksheetFunction.Match(ThisWorkbook.Worksheets(sheetNumber).Name, sheetsToExcludeArray, 0)) Then
                Call FormatThisSheet(startColumn, sheetNumber)
            End If
        Else
            Call FormatThisSheet(startColumn, sheetNumber)
        End If
    Next sheetNumber
Else
    Call FormatThisSheet(startColumn, ActiveSheet.Index)
End If

End Sub

---

Sub FormatThisSheet(startColumn As Long, sheetNumber As Long)

Dim lastRow As Long
Dim lastColumn As Long
Dim rangeToFormat As Range

With ThisWorkbook.Worksheets(sheetNumber)
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Set rangeToFormat = .Range(.Cells(1, startColumn), .Cells(lastRow, lastColumn))
    rangeToFormat.Cells.RowHeight = 9.4
    rangeToFormat.Cells.ColumnWidth = 11.2
End With

End Sub

基本上，这个想法是您的所有潜艇看起来都彼此相似，因为它们只用minor changes 做所有（几乎）相同的事情。因此，我决定将它们全部整合到一个潜艇中。当然，这意味着子需要知道minor changes。因此，我使用参数调用 sub 来告诉 sub 是应该格式化所有工作表还是只格式化活动工作表等。

所以，如果 Me.OptionButton5.Value 是 True，那么起始列是 B 列。这是工作表上的第二列，因此我将 startColumn = 2 传递给子。否则，我将 3 传递给 sub（从 C 列开始）。

对工作表采取了类似的方法。如果您想格式化所有工作表，那么我将设置布尔变量 True 否则我将其设置为 false 并再次将其传递给子以格式化相应的工作表。

您希望排除的所有工作表都存储在字符串变量中。因此，如果您决定不排除任何工作表，则 sheetsToExcludeList 将为空 sheetsToExcludeList = ""。但是，如果您决定排除 Cover 和 Indexes，则变量将变为此 sheetsToExcludeList = "Cover,Indexes"。

调整后的表格格式已修改以应对所有这些变量。请看一下，如果您有任何问题，请告诉我。