vba userform，如果框中的任何复选框都为true，则不应将宏应用于复选框中提到的工作表名称 [英] vba userform , if any of the checkboxes in the frame is true then macro should not be applied on the sheetname mentioned in the checkbox

问题描述

我已经创建了一个userform（更改活动工作表或所有工作表的列和行宽度），它有三个框架。
在第一帧中，我给了两个选项框。第一个选项框： - 要从列B向上更改列宽和其他选项框，以便从列c开始更改行列宽度。
用户将选择其中任何一个，然后移动到第二个框架：其中再次有两个选项可以使活动工作表和第二个选项框中的更改在所有工作表中进行更改。
因此，如果第一个窗体中的用户将选择第一个选项（从B向上更改行和列宽度，并且在第二个框架中将选择活动工作表，然后列和行宽度将从活动工作表中的B列开始更改等等...

现在我想创建第三个框架，其中有3个复选框，其名称为3张（Sheet1，Sheet2和Sheet3）。我想要如果第三帧中的用户选择任何复选框或所有复选框，则用户已经选择了第1和第2帧的选项，那么更改不应该应用于他选择的3个复选框中的任何一个中提到的表单。 / p>

我已经成功地执行了第一帧和第二帧，但是努力创建一个第3帧的代码，其中将有3个复选框（包含3张名称）被排除在请修改以下代码：

  Sub rowcola ctivesheetb（）
 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 
。范围（.Cells（1，2），.Cells（lastrow1，lastcolumn1））。选择
 Selection.Cells.RowHeight = 9.14 
 Selection.Cells.ColumnWidth = 7.14 
结束
 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 ）
对于Z = 1到Sheets.Count 
 ShtNames（Z）=表格（Z）.Name 
表格（Z）。选择
 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））。选择
 Selection.Cells .RowHeight = 9.14 
 Selection.Cells.ColumnWidth = 7.14 
下一个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））。选择
 Selection.Cells.RowHeight = 9.14 
 Selection.Cells.ColumnWidth = 7.14 
 End with 
 End Sub 
 
 Sub rowcolallsheetc （）
 
 Dim ex workb 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到ActiveWorkbook.Sheets.Count）
 
对于Z = 1到Sheets.Count 
 ShtNames（Z）=表格（Z ）.Name 
 Sheets（Z）.Select 
 lastrow1 = Sheets（Z）.Cells（Rows.Count，A）。End（xlUp）.Row 
 lastcolumn1 = ）.Cells（1，Columns.Count）.End（xlToLeft）.Column 
 ActiveWorkbook.Sheets（Z）.Range（Sheets（Z）.Cells（1，3），Sheets（Z）.Cells（lastrow1 ，lastcolumn1））。选择
 Selection.Cells.RowHeight = 9.14 
 Selection.Cells.ColumnWidth = 7.14 
下一个Z 
 End Sub 
  

Userform代码

  Private Sub CommandButton1_Click（）
如果Me.OptionButton5.Value = True然后
如果Me.OptionButton7.Value = True Then 
调用rowcolactivesheetb 
 ElseIf Me.OptionButton8.Value = True然后
 rowcolallsheetb 
 End If 
 End If 
如果Me.OptionButton6.Value = True Then 
如果Me.OptionButton7.Value = True然后
调用rowcolactivesheetc 
 ElseIf Me.OptionButton8.Value = True Then 
 rowcolallsheetc 
 End If 
 End If 
 End Sub 
  

解决方案

首先， t认为我会使用 OptionButtons 。从你的描述中，好像 ListBoxes 会更适合你。

其次，这可能更优雅将值传递给实际设置列和行的单个例程，而不是创建单独但几乎相同的例程。

我坚持使用您的 OptionButton 结构，并假设您所提及的三个额外的 OptionButtons 将被称为OptionButton9,10&因此，模块代码可能是这样的：

  Public Sub SizeRowsAndCols（fromB As Boolean，_ 
 fromC As Boolean，_ 
 targetActive As Boolean，_ 
 targetAll As Boolean，_ 
 excSheets As Variant）
 
 DimCol As Long 
 Dim sh As Worksheet 
 Dim nameString As Variant 
 
'定义列值
选择案例True 
案例fromB： fromCol = 2 
案例fromC：fromCol = 3 
案例：MsgBox列选择错误
结束选择
 
'在单张或多张表上运行例程
选择案例True 
案例targetActive 
 SetValuesOnSheet ThisWorkbook.ActiveSheet，fromCol 
案例targetAll 
对于每个sh在ThisWorkbook.Worksheets 
如果IsEmpty（excSheets）然后
'如果不排除图纸
 SetValuesOnSheet sh，fromCol 
 Else 
'排除列表中的表
对于每个nameString在excSheets 
如果sh 。名称<> nameString Then 
 SetValuesOnSheet sh，fromCol 
 End If 
 Next 
 End If 
 Next 
 Case Else 
 MsgBoxSheet selection error
结束选择
 End Sub 
 
 Private Sub SetValuesOnSheet（sh As Worksheet，fromCol As Long）
 Dim lastR As Long，lastC As Long 
 Dim rng As Range 
 
与sh 
 lastR = .Cells（.Rows.Count，A）。End（xlUp）.Row 
 lastC = .Cells（1，.Columns.Count ）.End（xlToLeft）.Column 
设置rng = .Range（.Cells（1，fromCol），.Cells（lastR，lastC））
 rng.RowHeight = 9.14 
 rng.ColumnWidth = 7.14 
结束
 End Sub 
  

而$ code > UserForm 代码可能是：

  Private Sub CommandButton1_Click（）
 Dim c As Long 
 Dim sheetNames As String 
 Dim list As Variant 
 
'构建排除表单列表
如果OptionButton9.Value然后sheetNames =Sheet1
如果OptionButton10.Value然后sheetNames = IIf（sheetNames<> ，|，）& Sheet2
如果OptionButton11.Value然后sheetNames = IIf（sheetNames"，|，）& Sheet3
 list = IIf（sheetNames，Split（sheetNames，|），Empty）
 
'调用通用例程
 SizeRowsAndCols OptionButton5。值$ _ 
 OptionButton6.Value，_ 
 OptionButton7.Value，_ 
 OptionButton8.Value，_ 
 list 
 
 End Sub 
  

I have created a userform (to change the column and row width of active sheet or all sheets )which has three frames. In the first frame I have given two option box. Firsts option box : - To change the row and column width from Column B onwards and other option box to change the row column width from column c onwards. User will select anyone of them and then move to second frame: which has again two options one to make the changes in active sheet and second option box to make the changes in all the sheets. So if the user in the first form will select first option (change row and column width from B onwards and in the second frame will select active sheet then the column and row width will change from Column B onwards in the active sheet and so on...

Now I want to create third fram which has 3 checkboxes which has name of 3 sheets (Sheet1, Sheet2 and Sheet3.) I want that when the user has selected his options in frame one and two if the user in the third fram select any of the checkboxes or all of the checkboxes then the changes should not apply in the sheetname mentioned in any of the 3 checkboxes which he has selected.

I have successfully executed frame one and frame 2 however struggling to create a code for frame 3 which will have 3 checkboxes (which contains name of 3 sheets) which is to excluded to make any row and column width changes.

Please find below my codes which are in the module:

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.14
            Selection.Cells.ColumnWidth = 7.14
        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 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, 2), Sheets(Z).Cells(lastrow1, lastcolumn1)).Select
        Selection.Cells.RowHeight = 9.14
        Selection.Cells.ColumnWidth = 7.14
    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.14
        Selection.Cells.ColumnWidth = 7.14
    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.14
        Selection.Cells.ColumnWidth = 7.14
    Next Z
End Sub

Userform code:

Private Sub CommandButton1_Click()
    If Me.OptionButton5.Value = True Then
        If Me.OptionButton7.Value = True Then
            Call rowcolactivesheetb
        ElseIf Me.OptionButton8.Value = True Then
            rowcolallsheetb
        End If
    End If
    If Me.OptionButton6.Value = True Then
        If Me.OptionButton7.Value = True Then
            Call rowcolactivesheetc
        ElseIf Me.OptionButton8.Value = True Then
            rowcolallsheetc
        End If
    End If
End Sub

解决方案

First of all, I don't think I'd use OptionButtons. From your description it seems as if ListBoxes would suit you far better.

Secondly, it might be more elegant to pass the values into a single routine that actually sets the columns and rows rather than creating separate but almost identical routines.

I've stuck with your OptionButton structure and made the assumption that the three additional OptionButtons you allude to will be called OptionButton9, 10 & 11.

So the module code could be something like this:

Public Sub SizeRowsAndCols(fromB As Boolean, _
                           fromC As Boolean, _
                           targetActive As Boolean, _
                           targetAll As Boolean, _
                           excSheets As Variant)

    Dim fromCol As Long
    Dim sh As Worksheet
    Dim nameString As Variant

    'Define the column value
    Select Case True
        Case fromB: fromCol = 2
        Case fromC: fromCol = 3
        Case Else: MsgBox "Column selection error"
    End Select

    'Run routine on single or multiple sheets
    Select Case True
        Case targetActive
            SetValuesOnSheet ThisWorkbook.ActiveSheet, fromCol
        Case targetAll
            For Each sh In ThisWorkbook.Worksheets
                If IsEmpty(excSheets) Then
                    'If no sheets are to be excluded
                    SetValuesOnSheet sh, fromCol
                Else
                    'Exclude the sheets in the list
                    For Each nameString In excSheets
                        If sh.Name <> nameString Then
                            SetValuesOnSheet sh, fromCol
                        End If
                    Next
                End If
            Next
        Case Else
            MsgBox "Sheet selection error"
    End Select
End Sub

Private Sub SetValuesOnSheet(sh As Worksheet, fromCol As Long)
    Dim lastR As Long, lastC As Long
    Dim rng As Range

    With sh
        lastR = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastC = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set rng = .Range(.Cells(1, fromCol), .Cells(lastR, lastC))
        rng.RowHeight = 9.14
        rng.ColumnWidth = 7.14
    End With
End Sub

And the UserForm code might be:

Private Sub CommandButton1_Click()
    Dim c As Long
    Dim sheetNames As String
    Dim list As Variant

    'Build the list of excluded sheets
    If OptionButton9.Value Then sheetNames = "Sheet1"
    If OptionButton10.Value Then sheetNames = IIf(sheetNames <> "", "|", "") & "Sheet2"
    If OptionButton11.Value Then sheetNames = IIf(sheetNames <> "", "|", "") & "Sheet3"
    list = IIf(sheetNames <> "", Split(sheetNames, "|"), Empty)

    'Call the generic routine
    SizeRowsAndCols OptionButton5.Value, _
                    OptionButton6.Value, _
                    OptionButton7.Value, _
                    OptionButton8.Value, _
                    list

End Sub

这篇关于vba userform，如果框中的任何复选框都为true，则不应将宏应用于复选框中提到的工作表名称的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！