将形状大小转换为厘米

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，指定相应形状属性的高/宽，单位为分：

Returns or sets the height of the specified object, in points. Read/write.

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

This example sets the height for row two in the specified table to 100 points (72 points per inch).

因此我想依靠这个事实并自己编写一个函数来转换它是安全的:

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

将形状大小转换为厘米

Convert shape size to cm

powerpoint

vba