Question

一直在四处寻找，看看我是否能够自己找到解决问题的方法，但我已经做空了......

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

第一帧 - 选项按钮5（B列以上），OptionButton6（C列以上）

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

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

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

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

第2帧：选择要更改行高和列宽的工作表（在“活动工作表”或“在所有工作表上”）

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

我已经开发了宏来改变列（B或C）和活动表以及所有工作表的列宽和行高，这些宏工作得非常好。直到现在我成功地连接了我的第一帧和第二帧（例如：当我在第一帧中选择“B列向前”时，在第二帧中选择“All Sheets”时，它正在改变列宽和行高。现在我想链接我的第三帧，一旦我在第一帧中选择“B列向前”，在第二帧中选择“All Sheets”，在第三帧中选择“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"。

修改了用于格式化工作表的子项已经过修改，以应对所有这些变量。如果您有任何问题，请查看并告诉我。

根据userform复选框值运行不同的宏

1 个答案: