OLEObject高度和宽度不一致

时间:2015-02-26 18:37:36

标签: excel vba excel-vba

我目前正在将PDF文件和图像作为OLE对象附加到我的Excel工作表,并尝试控制它们的大小。 (我希望图标沿网格显示)

问题在于,即使每个OLEObject都符合以下规范,它们有时也会有不同的大小。有些pdf的长度或宽度比图像文件长。

如何确保它们一致?

Public Sub OLEObjectNamesReturn()

Dim Count As Integer
Dim Space As Integer
Count = 23
Space = 0

For Each oleObj In ActiveSheet.OLEObjects
    Select Case oleObj.Name
    Case "CheckBox21"
    Case "CheckBox22"
    Case "CommandButton21"
    Case "CommandButton22"
    Case Else
        Dim ObjectName As String
        ObjectName = oleObj.Name
        Set oCell = ActiveSheet.Range("P" & Count)
        ActiveSheet.Shapes.Range(Array(ObjectName)).Select
        ActiveSheet.Shapes(ObjectName).Height = 30
        ActiveSheet.Shapes(ObjectName).Width = 30
        ActiveSheet.Shapes(ObjectName).Top = oCell.Top + 7 + Space
        ActiveSheet.Shapes(ObjectName).Left = oCell.Left + 7
        Count = Count + 1
        Space = Space + 15
    End Select
Next
End Sub

1 个答案:

答案 0 :(得分:8)

默认情况下,形状的宽高比(关系W / H)已锁定 ...所以实际上您的.Height.Width都是设置将更改尺寸(除非它们从开始就是方形)。如果您想要完美的正方形,无论形状的原始W / H比率如何,请解锁纵横比。

建议:

Sub Test()
Dim OleObj As OLEObject

    Set OleObj = ActiveSheet.OLEObjects(1)     ' embedded PDF A4 ... not icon
    OleObj.ShapeRange.LockAspectRatio = msoFalse
    OleObj.Height = 30
    OleObj.Width = 30

End Sub

经过测试,原本是A4尺寸的PDF ...一个人不必喜欢最后的样子; - )

如果要保持纵横比但仍希望将OLEObject放入30x30网格中,则需要将一个设置应用于较大的维度,例如

' ....

If OleObj.Width > OleObj.Height Then
    OleObj.Width = 30
Else
    OleObj.Height = 30
End If

' ....

然后 - 将对象水平居中,然后将(30 - OLEObj.Width)/2添加到oCell.Left等等......

相关问题