Question

我有一个VBA宏，允许用Excel指定Excel中列的宽度，单位为英寸/厘米，使用：

Application.InchesToPoints  
Application.CentimetersToPoints

我遇到的问题是它不准确。结果因正常样式选择的字体而异。

例如，如果我希望将前8列指定为1“宽，则宏将指定列为13个字符宽。当正常样式为Calibri 10 pt时，宽度应至少为13.43个字符当普通风格为世纪哥特式10磅时，宽度应等于或大于12.29个字符宽。

（行高有一个类似的宏。这也不是那么准确。）

问题：

Application.InchesToPoints和Application.CentimetersToPoints相对于特定的默认字体？
那是什么字体？
有没有办法纠正宏，以便更精确地指定以英寸为单位的列？

我正在使用的宏如下所示。

Sub SetColumnWidthInInches()
' This macro sets widths of rows in inches

    Dim Inches As Double, points As Double, savewidth As Double
    Dim lowerwidth As Double, upwidth As Double, curwidth As Integer
    Dim Count As Integer

    Application.ScreenUpdating = False
    Inches = Application.InputBox("Enter Column Width in Inches", _
    "Column Width (Inches)", Type:=1)

    If Inches = False Then Exit Sub

    points = Application.InchesToPoints(Inches)
    savewidth = ActiveCell.ColumnWidth
    ActiveCell.ColumnWidth = 255

    If points > ActiveCell.Width Then
        MsgBox "Width of " & Inches & " is too large." & Chr(10) & _
            "The maximum value is " & _
            Format(ActiveCell.Width / 28.3464566929134, _
            "0.00"), vbOKOnly + vbExclamation, "Width Error"
        ActiveCell.ColumnWidth = savewidth
        Exit Sub
    End If

    lowerwidth = 0
    upwidth = 255
    ActiveCell.ColumnWidth = 127.5
    curwidth = ActiveCell.ColumnWidth
    Count = 0

    While (ActiveCell.Width <> points) And (Count < 20)
        If ActiveCell.Width < points Then
            lowerwidth = curwidth
            Selection.ColumnWidth = (curwidth + upwidth) / 2
        Else
            upwidth = curwidth
            Selection.ColumnWidth = (curwidth + lowerwidth) / 2
        End If
        curwidth = ActiveCell.ColumnWidth
        Count = Count + 1
    Wend
End Sub

Answer 1

谢谢您的回答。我决定创建自己的Application.InchesToPoints“公式”，而不是使用Microsoft的“公式”。每种字体都需要一个唯一的公式。由于Microsoft的列大小和行大小的舍入，它仍然不准确，但是我的公式很接近。

我希望我所有的电子表格都具有相同的大小，并在页边距之间填充空白。因此，我编写了第二个宏，该宏“棘轮”向上或向下滚动一列和一行的大小，以便填满整个页面以弥补舍入问题。

要设置行高，我这样写：

Sub SetRowHeightInInches（） ' '此宏设置行高 '以英寸为单位显示某些字体

'

暗点尺寸为两倍，点为两倍，坡度为两倍，常数为两倍 Application.ScreenUpdating = False

如果ThisWorkbook.Styles（“ Normal”）。Font.Size =（10）然后

If ThisWorkbook.Styles("Normal").Font.Name = "Arial" Then
    Slope = 74.222
    Constant = -0.0788
ElseIf ThisWorkbook.Styles("Normal").Font.Name = "Calibri" Then
    Slope = 70.1009
    Constant = -0.0735
ElseIf ThisWorkbook.Styles("Normal").Font.Name = "Century Gothic" Then
    Slope = 74.906
    Constant = -0.0588
Else
    MsgBox "The normal font for this workbook is not 8-10 pt Arial, Calibri or Century Gothic. This macro will yield an approximation."
    Slope = 73.0763
    Constant = -0.0704
End If

ElseIf ThisWorkbook.Styles（“ Normal”）。Font.Size =（9）然后

If ThisWorkbook.Styles("Normal").Font.Name = "Arial" Then
    Slope = 77.3051
    Constant = -0.0791
ElseIf ThisWorkbook.Styles("Normal").Font.Name = "Calibri" Then
    Slope = 72.6606
    Constant = -0.0568
ElseIf ThisWorkbook.Styles("Normal").Font.Name = "Century Gothic" Then
    Slope = 86.2616
    Constant = -0.0727
Else
    MsgBox "The normal font for this workbook is not 8-10 pt Arial, Calibri or Century Gothic. This macro will yield an approximation."
    Slope = 78.7424
    Constant = -0.0695
End If

ElseIf ThisWorkbook.Styles（“ Normal”）。Font.Size =（8）然后

If ThisWorkbook.Styles("Normal").Font.Name = "Arial" Then
    Slope = 79.303
    Constant = -0.0759
ElseIf ThisWorkbook.Styles("Normal").Font.Name = "Calibri" Then
    Slope = 74.9169
    Constant = -0.1002
ElseIf ThisWorkbook.Styles("Normal").Font.Name = "Century Gothic" Then
    Slope = 88.8749
    Constant = -0.0216
Else
    MsgBox "The normal font for this workbook is not 8-10 pt Arial, Calibri or Century Gothic. This macro will yield an approximation."
    Slope = 81.0316
    Constant = -0.0659
End If

如果结束

Inches = Application.InputBox("Enter Row Height in Inches", _
"Row Height (Inches)", Type:=1)

If Inches Then

    Points = Inches * Slope + Constant
    Selection.RowHeight = Points

End If

结束子

要设置列宽，我这样写：

Sub SetColWidthInInches（） ' '此宏设置列的宽度 '以英寸为单位显示某些字体

'

暗点尺寸为两倍，点为两倍，坡度为两倍，常数为两倍 Application.ScreenUpdating = False

如果ThisWorkbook.Styles（“ Normal”）。Font.Size =（10）然后

If ThisWorkbook.Styles("Normal").Font.Name = "Arial" Then
    Slope = 13.0253
    Constant = -0.7805
ElseIf ThisWorkbook.Styles("Normal").Font.Name = "Calibri" Then
    Slope = 14.2722
    Constant = -0.7976
ElseIf ThisWorkbook.Styles("Normal").Font.Name = "Century Gothic" Then
    Slope = 13.0314
    Constant = -0.7946
Else
    MsgBox "The normal font for this workbook is not 8-10 pt Arial, Calibri or Century Gothic. This macro will yield an approximation."
    Slope = 13.3214
    Constant = -0.7946
End If

ElseIf ThisWorkbook.Styles（“ Normal”）。Font.Size =（9）然后

If ThisWorkbook.Styles("Normal").Font.Name = "Arial" Then
    Slope = 14.2722
    Constant = -0.7976
ElseIf ThisWorkbook.Styles("Normal").Font.Name = "Calibri" Then
    Slope = 15.7747
    Constant = -0.902
ElseIf ThisWorkbook.Styles("Normal").Font.Name = "Century Gothic" Then
    Slope = 14.2747
    Constant = -0.7961
Else
    MsgBox "The normal font for this workbook is not 8-10 pt Arial, Calibri or Century Gothic. This macro will yield an approximation."
    Slope = 14.2747
    Constant = -0.7976
End If

ElseIf ThisWorkbook.Styles（“ Normal”）。Font.Size =（8）然后

If ThisWorkbook.Styles("Normal").Font.Name = "Arial" Then
    Slope = 16.2077
    Constant = -0.9478
ElseIf ThisWorkbook.Styles("Normal").Font.Name = "Calibri" Then
    Slope = 17.6073
    Constant = -0.9255
ElseIf ThisWorkbook.Styles("Normal").Font.Name = "Century Gothic" Then
    Slope = 16.2077
    Constant = -0.9478
Else
    MsgBox "The normal font for this workbook is not 8-10 pt Arial, Calibri or Century Gothic. This macro will yield an approximation."
    Slope = 16.2077
    Constant = -0.9478
End If

如果结束

Inches = Application.InputBox("Enter Column Width in Inches", _
"Column Width (Inches)", Type:=1)

If Inches Then

    Points = Inches * Slope + Constant
    Selection.ColumnWidth = Points

End If

结束子

要填充我写的页面：

Sub AutoFitColumn（） ' '更改列大小 '填写工作表

'

暗淡尺寸为单大小= Selection.ColumnWidth 'Application.ScreenUpdating = False

如果ActiveSheet.VPageBreaks.Count = 0那么

Do
  Size = Size + 0.2
  Selection.ColumnWidth = Size
Loop Until ActiveSheet.VPageBreaks.Count = 1
End If

如果ActiveSheet.VPageBreaks.Count> 0然后

Do
  Size = Size - 0.1
  Selection.ColumnWidth = Size
Loop Until ActiveSheet.VPageBreaks.Count = 0
End If

范围（“ A1”）。选择

结束子

还有这个

Sub AutoFitRow（） ' '更改行大小 '填写工作表

'

暗淡尺寸为单大小= Selection.RowHeight 'Application.ScreenUpdating = False

If ActiveSheet.HPageBreaks.Count = 0 Then

Do
  Size = Size + 0.5
  Selection.RowHeight = Size
Loop Until ActiveSheet.HPageBreaks.Count = 1
End If

如果ActiveSheet.HPageBreaks.Count> 0然后

Do
  Size = Size - 0.25
  Selection.RowHeight = Size
Loop Until ActiveSheet.HPageBreaks.Count = 0
End If

范围（“ A1”）。选择

结束子

如何在Excel中创建EXTRA精确列宽？

1 个答案: