|
以下是引用xiaog在2003-6-1 0:15:00的发言：
按厘米或英寸改变单元格的行高、列宽（微软）
'一、按厘米改变
Sub RowHeightInCentimeters()
Dim cm As Integer
' Get the row height in centimeters.
cm = Application.InputBox("Enter Row Height in Centimeters", _
"Row Height (cm)", Type:=1)
' If cancel button not pressed and a value entered.
If cm Then
' Convert and set the row height
Selection.RowHeight = Application.CentimetersToPoints(cm)
End If
End Sub
Sub ColumnWidthInCentimeters()
Dim cm As Integer, points As Integer, savewidth As Integer
Dim lowerwidth As Integer, upwidth As Integer, curwidth As Integer
Dim Count As Integer
' Turn screen updating off.
Application.ScreenUpdating = False
' Ask for the width in inches wanted.
cm = Application.InputBox("Enter Column Width in Centimeters", _
"Column Width (cm)", Type:=1)
' If cancel button for the input box was pressed, exit procedure.
If cm = False Then Exit Sub
' Convert the inches entered to points.
points = Application.CentimetersToPoints(cm)
' Save the current column width setting.
savewidth = ActiveCell.ColumnWidth
' Set the column width to the maximum allowed.
ActiveCell.ColumnWidth = 255
' If the points desired is greater than the points for 255
' characters...
If points > ActiveCell.Width Then
' Display a message box because the size specified is too
' large and give the maximum allowed value.
MsgBox "Width of " & cm & " is too large." & Chr(10) & _
"The maximum value is " & _
Format(ActiveCell.Width / 28.3464566929134, _
"0.00"), vbOKOnly + vbExclamation, "Width Error"
' Reset the column width back to the original.
ActiveCell.ColumnWidth = savewidth
' Exit the Sub.
Exit Sub
End If
' Set the lowerwidth and upper width variables.
lowerwidth = 0
upwidth = 255
' Set the column width to the middle of the allowed character
' range.
ActiveCell.ColumnWidth = 127.5
curwidth = ActiveCell.ColumnWidth
' Set the count to 0 so if it can't find an exact match it won't
' go on indefinitely.
Count = 0
' Loop as long as the cell width in is different from width
' wanted and the count (iterations) of the loop is less than 20.
While (ActiveCell.Width <> points) And (Count < 20)
' If active cell width is less than desired cell width.
If ActiveCell.Width < points Then
' Reset lower width to current width.
lowerwidth = curwidth
' set current column width to the midpoint of curwidth
' and upwidth.
Selection.ColumnWidth = (curwidth + upwidth) / 2
' If active cell width is greater than desired cell width.
Else
' Set upwidth to the curwidth.
upwidth = curwidth
' Set column width to the mid point of curwidth and lower
' width.
Selection.ColumnWidth = (curwidth + lowerwidth) / 2
End If
' Set curwidth to the width of the column now.
curwidth = ActiveCell.ColumnWidth
' Increment the count counter.
Count = Count + 1
Wend
End Sub
‘******************************************************************
'二、按英寸改变
Sub RowHeightInInches()
Dim inches As Integer
' Get the desired column width.
inches = Application.InputBox("Enter Row Height in Inches", _
"Row Height (Inches)", Type:=1)
' If the cancel button was not pressed.
If inches Then
' Convert and set the column height.
Selection.RowHeight = Application.InchesToPoints(inches)
End If
End Sub
Sub ColumnWidthInInches()
Dim inches As Integer, points As Integer, savewidth As Integer
Dim lowerwidth As Integer, upwidth As Integer, curwidth As Integer
Dim Count As Integer
' Turn screen updating off.
Application.ScreenUpdating = False
' Ask for the desired width in inches.
inches = Application.InputBox("Enter Column Width in Inches", _
"Column Width (Inches)", Type:=1)
' If the cancel button for the input box is pressed, exit the
' procedure.
If inches = False Then Exit Sub
' Convert the entered inches to points.
points = Application.InchesToPoints(inches)
' Save the current column width setting.
savewidth = ActiveCell.ColumnWidth
' Set the column width to the maximum allowed.
ActiveCell.ColumnWidth = 255
' If points wanted is greater than points for 255 characters.
If points > ActiveCell.Width Then
' Display a message box (the specified size is too large), and
' let user know maximum allowed value.
MsgBox "Width of " & inches & " is too large." & Chr(10) & _
"The maximum value is " & Format(ActiveCell.Width / 72, _
"0.00"), vbOKOnly + vbExclamation, "Width Error"
' Reset the column width back to the original.
ActiveCell.ColumnWidth = savewidth
' Exit out of the Sub from here.
Exit Sub
End If
' Set the lowerwidth and upperwidth variables.
lowerwidth = 0
upwidth = 255
' Set the column width to the middle of the allowed character range.
ActiveCell.ColumnWidth = 127.5
curwidth = ActiveCell.ColumnWidth
' Set the count to 0 so if it can't find an exact match it won't go
' indefinitely.
Count = 0
' Loop as long as the cell width is different from width desired
' and the count (iterations) of the loop is less than 20.
While (ActiveCell.Width <> points) And (Count < 20)
' If active cell width is less than desired cell width.
If ActiveCell.Width < points Then
' Reset lower width to current width.
lowerwidth = curwidth
' Set current column width to the midpoint of curwidth and
' upwidth.
Selection.ColumnWidth = (curwidth + upwidth) / 2
' If active cell width is greater than desired width.
Else
' Set upwidth to the curwidth.
upwidth = curwidth
' Set column width to the mid point of curwidth and lower
' width.
Selection.ColumnWidth = (curwidth + lowerwidth) / 2
End If
' Set curwidth to the width of the column now.
curwidth = ActiveCell.ColumnWidth
' Increment the count counter.
Count = Count + 1
Wend
End Sub
谢谢，很不错的 | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2003-5-19 18:58
