Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
Bianca777 la Simpatie.ro
 | Femeie
19 ani
Brasov
cauta Barbat
19 - 61 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 748
|
|
Source - my question on computing.net
I want to add 2 buttons in the QAT and press button1 to set a value for row height (eg 28), then press button2 to set the height of the active row to the previously set value (28).
I will not use consecutive height adjustments.
- I press button1 and set the height and store the value.
- Then I press button2 for one row, then do some text editing in another row, then move to a 3rd row and press button2 again if it is required to set the row height. And so on.
- If I want to change the height, I click button1 again and store a new value.
I thought to use 2 Subs for this:
- 1st with an InputBox to insert the desired value manually and store/memorize it for later use
- 2nd to set the row height using the value set before
My first solution, not the best and fastest, but working:
Button 1 in QAT:
The code creates a new very hidden worksheet in the active workbook, if one does not already exist.
An InputBox asking for the desired row height appears and then the value is stored in Worksheets("VeryHidden").Range("A1").
Button 2 in QAT
The code extracts the value stored in Worksheets("VeryHidden").Range("A1") and changes the height of the row where the active cell is located.
I press button 2 for the same adjustment everywhere I need it, then press button 1 only when I want to change the height.
Option Explicit
Public h As String
Public rng As Range
Public Ws As Worksheet
' button 1 - create very hidden ws and store value in it
Sub DefineHeight()
For Each Ws In Worksheets
If Ws.Name = "VeryHidden" Then
GoTo SetRange
End If
Next
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "VeryHidden"
Set Ws = Worksheets("VeryHidden")
Ws.Visible = xlSheetVeryHidden
SetRange:
Set rng = Worksheets("VeryHidden").Range("A1")
h = InputBox("Insert row height")
If IsNumeric(h) Then
rng.Value = h
Else
MsgBox "You haven't entered a number"
Exit Sub
End If
End Sub
' button 2 - extract that value and adjust row height
Sub AdjustRowHeight()
Set rng = Worksheets("VeryHidden").Range("A1")
With ActiveSheet.Rows(ActiveCell.row)
.RowHeight = rng
End With
End Sub
' button 3 - optional, if you want to delete the VeryHidden sheet
Sub DeleteHidden()
Application.DisplayAlerts = False
For Each Ws In Worksheets
If Ws.Name = "VeryHidden" Then
Ws.Visible = xlSheetHidden
Ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub |
DerbyDad03 suggestions to improve (will edit the main code soon):
You do not need to loop through the sheets to determine if a specific sheet exists. You can ask Excel to look for it directly via ISREF.
In addition...
If you use the Application.InputBox method, you can allow the user to Cancel cleanly.
If you specify a Type for the InputBox, you don't have to check for a "number", VBA will do it for you.
Finally, you appear to have used SetRange as a label and I'm not sure why. Labels are usually used in conjunction with a GoTo statement. If you meant for SetRange to be a comment, then you should use the standard 'SetRange notation.
When you create a label, the VBA compiler has to do extra work. You'll probably never notice the difference, but it's a bad habit to use labels as comments.
Sub DefineHeight()
'Add sheet if VeryHidden doesn't exist
If Not Evaluate("ISREF('" & "VeryHidden" & "'!A1)") Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "VeryHidden"
Set Ws = Worksheets("VeryHidden")
Ws.Visible = xlSheetVeryHidden
End If
Set rng = Worksheets("VeryHidden").Range("A1")
h = Application.InputBox("Insert row height", Type:=1)
'Allow cancel or use value
If h = False Then
Exit Sub
Else
rng.Value = h
End If
End Sub |
|
|
| pus acum 5 ani |
|