如何在VBA函数中复制图片并设置其位置与尺寸参数？

错误原因：新建工作表中不存在名为SLogo的形状，直接通过.Shapes("SLogo")引用会找不到对象，触发"Object doesn't support this property or method"错误。正确逻辑是先粘贴形状，再捕获刚粘贴的对象来设置属性。

修正后的代码：

Function CreateStandardSheet(wkb As Workbook, SheetName As String) As Worksheet
    Dim newSheet As Worksheet
    Dim pastedLogo As ShapeRange
    
    '新建工作表并指定名称
    Set newSheet = wkb.Sheets.Add(After:=wkb.Sheets(wkb.Sheets.Count))
    newSheet.Name = SheetName
    
    '复制源工作表中的目标形状
    wkb.Worksheets("Frontsheet").Shapes("SLogo").Copy
    
    '粘贴到新工作表并获取粘贴的形状对象
    Set pastedLogo = newSheet.Shapes.Paste
    
    '设置形状的位置与尺寸参数
    With pastedLogo(1)
        .Top = 300
        .Left = 550
        .Width = 250
        '按需添加高度设置：.Height = 100
    End With
    
    Set CreateStandardSheet = newSheet
End Function

关键修改说明 #

• 新增变量捕获粘贴后的形状对象，避免通过名称查找不存在的形状
• 利用返回的ShapeRange对象直接设置Top、Left、Width属性
• 补充了工作表名称的设置（原函数参数SheetName未使用，完善逻辑）

替代方案（针对图片类型形状） #

如果源对象是图片，也可以使用Pictures.Paste方法，返回Picture对象：

Function CreateStandardSheet(wkb As Workbook, SheetName As String) As Worksheet
    Dim newSheet As Worksheet
    Dim pastedPic As Picture
    
    Set newSheet = wkb.Sheets.Add(After:=wkb.Sheets(wkb.Sheets.Count))
    newSheet.Name = SheetName
    
    wkb.Worksheets("Frontsheet").Shapes("SLogo").Copy
    Set pastedPic = newSheet.Pictures.Paste
    
    With pastedPic
        .Top = 300
        .Left = 550
        .Width = 250
    End With
    
    Set CreateStandardSheet = newSheet
End Function

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