将形状大小转换为厘米

Question

我有用于更改形状大小的 VBA 代码，但我想将数字转换为厘米。关于如何转换这些数字的任何建议？
另一个问题是我想为多个选定的形状更改相同的大小；你能帮我解决这个问题吗？

非常感谢！

Sub test()
    Dim objHeigh As Integer
    Dim objWidth As Integer
    Dim oSh As Shape

    On Error GoTo CheckErrors

    With ActiveWindow.Selection.ShapeRange
        If .Count = 0 Then
            MsgBox "You need to select a shape first"
            Exit Sub
        End If
    End With

    For Each oSh In ActiveWindow.Selection.ShapeRange
        objHeigh = oSh.Height
        objWidth = oSh.Width

        objHeigh = CInt(InputBox$("Assign a new size of Height", "Heigh", objHeigh))
        ' give the user a way out
        If objHeigh = 0 Then
            Exit Sub
        End If

        If objName <> "" Then
            oSh.Name = objName
        End If

        objWidth = CInt(InputBox$("Assign a new size of Width", "Width", objWidth))
        ' give the user a way out
        If objWidth = 0 Then
            Exit Sub
        End If

        oSh.Height = CInt(objHeigh)
        oSh.Width = CInt(objWidth)
    Next
    Exit Sub

    CheckErrors: MsgBox Err.Description
End Sub 

Answer 1

根据MSDN，相应形状属性的高度/宽度以点为单位指定：

返回或设置指定对象的高度，以磅为单位。读/写。

在那个页面上，他们专门展示了一个例子，并提到了一个事实，即 1 英寸有 72 点

本示例将指定表格中第二行的高度设置为 100 磅（每英寸 72 磅）。

因此，我想可以安全地依赖这个事实，只需编写一个函数来自己转换它：

Function ConvertPointToCm(ByVal pnt As Double) As Double
    ConvertPointToCm = pnt * 0.03527778
End Function

Function ConvertCmToPoint(ByVal cm As Double) As Double
    ConvertCmToPoint = cm * 28.34646
End Function

就您关于调整多个对象大小的问题而言，我不确定我是否完全理解您的问题。我以某种方式解释它，以便将您的提示移出For循环应该给您所需的结果（如果这实际上是您想要的结果:)）：

objHeigh = CInt(InputBox$("Assign a new size of Height", "Heigh"))
' give the user a way out
If objHeigh = 0 Then
    Exit Sub
End If
objHeigh = ConvertCmToPoint(objHeigh)

objWidth = CInt(InputBox$("Assign a new size of Width", "Width"))
' give the user a way out
If objWidth = 0 Then
    Exit Sub
End If
objWidth = ConvertCmToPoint(objWidth)

For Each oSh In ActiveWindow.Selection.ShapeRange
    If objName <> "" Then
        oSh.Name = objName
    End If

    oSh.Height = CInt(objHeigh)
    oSh.Width = CInt(objWidth)
Next