vba - OLEObject 高度和宽度不一致

标签 vba excel

我目前正在将 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

最佳答案

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

建议:

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 等...

关于vba - OLEObject 高度和宽度不一致,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/28750196/

相关文章:

class - 使用 ClassModule 属性添加数组键

excel - 仅将单元格中的某些字符与另一个单元格中的某些字符进行比较

vba - 数据更改时自动刷新数据透视表

python - 值错误 : Invalid character found in sheet title

vba - 使用 VBA 和 VB.NET API 处理多个窗口

php - 我想从 mysql 数据库中导出一个 excel。我想在复选框的帮助下获得用户的列名

excel - 创建全局文件路径

vba - 比较excel中的两个单元格然后返回行

excel - 使用货币格式设置多范围列表框的格式

arrays - Excel VBA 数组 - 获取#Value!尝试将数组转储到电子表格时出错