Question

我正在创建一个包含2个文本框，4个不同复选框，4个径向按钮和2个命令按钮的用户窗体，如下所示：

我想根据表单中的选择更改活动工作表中的行宽和列宽，或工作簿中的所有工作表。

帧

- TextBox1（列宽），TextBox2（行高）
- 键入行高和列宽。
- Optionbutton1（B列以上），OptionButton2（C列以上）
- 选择要更改列宽的列（B或C）。
- Optionbutton3（Selected Sheet），OptionButton4（All sheets）
- 选择要更改行高和列宽的工作表（在“活动工作表”或“在所有工作表上”）。
- CheckBox1（封面），CheckBox2（Trans_Letter），CheckBox3（缩写）CheckBox3（以_Index结尾的工作表）
- 我的工作簿中有4个工作表的每个复选框。我的工作簿中有大约50张，这些复选框用于在更改所有工作表时更改列宽和行高时选择要排除的工作表。

请在下面找到我在userform中输入的代码。

我在这一行上收到错误：

If IsError(WorksheetFunction.Match(ThisWorkbook.Worksheets(sheetNumber).Name, sheetsToExcludeArray, 0)) Then

错误消息：运行时错误＆＃39; 1004＆＃39;无法获得Match属性工作表函数

Private Sub CommandButton1_Click()    
    Dim startColumn As Long    
    Dim formatAllSheets As Boolean    
    Dim sheetsToExcludeList As String    
    Dim sheetNumber As Long    
    startColumn = 3
    If Me.OptionButton1.Value Then startColumn = 2    
    formatAllSheets = True    
    If Me.OptionButton3.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 & ",Index"
    sheetsToExcludeList = Mid(sheetsToExcludeList, 2)

    Dim lastRow As Long    
    Dim lastColumn As Long    
    Dim itemInArray As Long    
    Dim rangeToFormat As Range    
    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         
                    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 = me.textbox1.value
                        rangeToFormat.Cells.ColumnWidth = me.textbox2.value
                    End With    
                End If
            Else
                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 = me.textbox1.value
                    rangeToFormat.Cells.ColumnWidth = me.texbox2.value
                End With    
            End If    
        Next sheetNumber    
    Else 
        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 = me.textbox1.value
            rangeToFormat.Cells.ColumnWidth = me.textbox2.value     
        End With    
    End If    
End Sub

Answer 1

请注意，此答案使用了对resizerowscols的修改，我写这篇文章是为了回答您最近提出的问题：Change column width and row height of hidden columns and rows (remaining hidden): Excel VBA

主要点击子

这个（未经测试的）子获取表单中的值，然后遍历表单（或只使用活动表）并调用另一个子进行调整大小。

Sub CommandButton1_Click()
    ' Frame 1 values
    Dim colwidth As Double
    colwidth = Me.TextBox1.Value
    Dim rowheight As Double
    rowheight = Me.TextBox2.Value
    ' Frame 2 values
    Dim selectedCol As String
    If Me.OptionButton1.Value = True Then
        selectedCol = "B"
    Else
        selectedCol = "C"
    End If
    ' Frame 3 values
    Dim doAllSheets As Boolean
    doAllSheets = Me.OptionButton4.Value
    'Frame 4 values
    Dim sheetsToExcludeList As String
    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 & ",Index"
    ' Resizing
    Dim shtrng As Range
    Dim sht As Worksheet
    If doAllSheets Then
        ' Loop through sheets
        For Each sht In ThisWorkbook.Sheets
            ' Check sheet name isn't on exclude list
            If InStr(sheetsToExcludeList, "," & sht.Name) = 0 Then
                ' Set range equal to intersection of used range and columns "selected column" onwards
                Set shtrng = Intersect(sht.UsedRange, sht.Range(sht.Cells(1, selectedCol), sht.Cells(1, sht.Columns.Count)).EntireColumn)
                ' Resize columns / rows
                resizerowscols rng:=shtrng, w:=colwidth, h:=rowheight
            End If
        Next sht
    Else
        ' Just active sheet
        Set sht = ThisWorkbook.ActiveSheet
        Set shtrng = Intersect(sht.UsedRange, sht.Range(sht.Cells(1, selectedCol), sht.Cells(1, sht.Columns.Count)).EntireColumn)
        resizerowscols rng:=shtrng, w:=colwidth, h:=rowheight
    End If
End Sub

这是您的另一个问题的改编Sub，但现在它将范围，高度和宽度作为参数。它取消隐藏所有行/列，调整它们的大小，并重新隐藏所有已经存在的行/列。

Sub resizerowscols(rng As Range, w As Double, h As Double)
' Resizes all rows and columns, including those which are hidden.
' At the end, hidden rows and columns remain hidden.
    If rng Is Nothing Then Exit Sub
    Dim n As Long
    Dim hiddencols() As Long
    Dim hiddenrows() As Long
    Application.ScreenUpdating = False
    ' Get hidden rows/cols
    ReDim hiddencols(rng.Columns.Count)
    ReDim hiddenrows(rng.Rows.Count)
    For n = 0 To UBound(hiddencols)
        hiddencols(n) = rng.Columns(n + 1).Hidden
    Next n
    For n = 0 To UBound(hiddenrows)
        hiddenrows(n) = rng.Rows(n + 1).Hidden
    Next n
    ' Unhide all
    rng.EntireColumn.Hidden = False
    rng.EntireRow.Hidden = False
    ' resize all
    rng.ColumnWidth = w
    rng.rowheight = h
    ' Re-hide rows/cols
    For n = 0 To UBound(hiddencols)
        rng.Columns(n + 1).Hidden = hiddencols(n)
    Next n
    For n = 0 To UBound(hiddenrows)
        rng.Rows(n + 1).Hidden = hiddenrows(n)
    Next n
    Application.ScreenUpdating = True
End Sub

Userform更改列宽和行高

1 个答案: