OLEObject Height and Width are not consistent

2020-02-13 01:54发布

I am currently attaching PDF files and images to my excel sheet as OLE Objects, and trying to control the size of them. (I want the icons to appear along a grid)

The problem is that even though each OLEObject should meet the following specifications, they are sometimes different sizes. Some pdfs have greater lengths, or widths then image files.

How do I make sure they are consistent?

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条回答
我只想做你的唯一
2楼-- · 2020-02-13 02:15

By default shapes have their aspect ratio (relation W/H) locked ... so in fact both your .Height and .Width settings will change both dimensions (unless they are square from start). If you want perfect squares no matter what is the original W/H ratio of your shapes, unlock the aspect ratio.

Suggestion:

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

Tested wit a PDF originally A4 size ... one doesn't have to like the final look ;-)

If you want to maintain the aspect ratio but still want to fit your OLEObject into a 30x30 grid, you need to apply one single setting to the larger dimension, e.g.

' ....

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

' ....

Then - to horizontally center the object you'd add (30 - OLEObj.Width)/2 to oCell.Left etc etc ...

查看更多
登录 后发表回答