Excel区域转图片粘贴到PPT后无法调整尺寸的代码修改方法咨询

解决核心 #

在调整图片尺寸、位置参数前，先显式关闭图片的锁定纵横比属性即可，不同开发环境下的实现方式如下：

粘贴生成图片对象后，先修改LockAspectRatio属性为关闭状态，再执行尺寸、位置调整操作即可生效。
示例代码片段：

Dim pptApp As Object, pptPres As Object, pptSlide As Object, pptShape As Object
' PPT应用初始化、幻灯片创建代码省略
' 复制Excel指定单元格区域为图片
Sheet1.Range("A1:C10").CopyPicture Appearance:=xlScreen, Format:=xlPicture
' 粘贴到PPT并获取图片对象
Set pptShape = pptSlide.Shapes.PasteSpecial(DataType:=ppPastePNG)

' 先关闭锁定纵横比，无类型库引用时可替换 msoFalse 为 0
pptShape.LockAspectRatio = msoFalse

' 后续调整参数即可正常生效
pptShape.Width = 400  ' 自定义宽度，单位为磅
pptShape.Height = 300 ' 自定义高度
pptShape.Left = 50    ' 自定义左边距
pptShape.Top = 80     ' 自定义上边距

import win32com.client as win32

excel = win32.gencache.EnsureDispatch('Excel.Application')
ppt = win32.gencache.EnsureDispatch('PowerPoint.Application')
# 工作簿、演示文稿、目标幻灯片初始化代码省略
# 复制Excel单元格区域为图片
excel.Worksheets('Sheet1').Range('A1:C10').CopyPicture(Appearance=1, Format=2)
# 粘贴到PPT获取图片对象
ppt_shape = ppt.ActivePresentation.Slides(1).Shapes.PasteSpecial(DataType=2)

# 关闭锁定纵横比
ppt_shape.LockAspectRatio = 0

# 后续调整参数即可生效
ppt_shape.Width = 400
ppt_shape.Height = 300
ppt_shape.Left = 50
ppt_shape.Top = 80

• 关闭锁定纵横比的代码必须放在调整尺寸、位置的代码之前，顺序颠倒不会生效
• 批量处理多张图片时，需要对每一张粘贴生成的图片对象单独设置该属性
• 若粘贴后直接获取对象失败，可通过Shapes(Shapes.Count)获取最新粘贴的图片对象再设置属性

内容的提问来源于stack exchange，提问作者Amruta Vadnere