Revision: 9297
Initial Code
Initial URL
Initial Description
Initial Title
Initial Tags
Initial Language
at October 29, 2008 06:53 by Wardy
Initial Code
Sub MakeSquareCells2()
Dim wid As Single
Dim myPts As Single
Dim myRange As Range
'get from user the range to make square cells in.
On Error GoTo TheEnd
Set myRange = Application.InputBox _
("Select a range in which to create square cells", Type:=8)
On Error Resume Next
If myRange.Cells.Count = 0 Then Exit Sub
GetWidth:
'get from user the width of the cells
wid = Val(InputBox("Input Column Width: "))
If wid > 0 And wid < 0.05 Then
MsgBox "Invalid column width value"
GoTo GetWidth
ElseIf wid <= 0 Then Exit Sub
End If
'don't drive the person crazy watching you work
Application.ScreenUpdating = False
myRange.EntireColumn.ColumnWidth = wid
myPts = myRange(1).Width
myRange.EntireRow.RowHeight = myPts
'show the person what you've done
Application.ScreenUpdating = True
TheEnd:
End Sub
Initial URL
http://www.mrexcel.com/tip071.shtml
Initial Description
Initial Title
Excel as Gridpaper for Drawing
Initial Tags
excel
Initial Language
Visual Basic