dimanche 16 avril 2017

In Userform Link Checkboxes with options button

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




Aucun commentaire:

Enregistrer un commentaire