如何解决复制为图片的Excel区域在Word中无法固定调整尺寸的问题？

将Excel表格指定区域复制为图片插入Word并调整为固定尺寸的VBA代码，此前可正常运行，现在无法实现尺寸调整。已尝试修改尺寸参数、重启电脑及Excel，问题仍存在。

用户使用的VBA代码如下：

Sub InsertPictureOfTable()
'    Dim W As Word.Application
'    Dim d As Word.Document
'    Dim shp As Shape
    Dim objInlineShape As InlineShape
    
    With WordApp.Selection
        ' Copy table to buffer
        Tabelle1.Range("Punktetabelle").Copy

        ' Paste table from clipboard
        doc.Bookmarks("Punktetabelle2").Range.PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine

        ' Get reference to the InlineShape object of the inserted image
        Set objInlineShape = doc.InlineShapes(doc.InlineShapes.Count)

        ' Change the size of the image
        With objInlineShape
            .Width = 574
            .Height = 667
        End With
        
        ' Centre image
        With objInlineShape.Range.Paragraphs(1)
            .Alignment = wdAlignParagraphCenter ' Center the paragraph horizontally
            .SpaceBefore = 0 ' Remove any space before the paragraph
        End With
    End With
End Sub

• 显式初始化Word对象
  代码中直接使用WordApp和doc但未声明初始化，可能导致对象引用失效。建议补充对象初始化逻辑：

  Dim WordApp As Word.Application
  Dim doc As Word.Document
  ' 初始化Word应用
  Set WordApp = New Word.Application
  WordApp.Visible = True ' 调试时可开启，方便查看效果
  ' 替换为你的目标文档路径
  Set doc = WordApp.Documents.Open("C:\YourTargetDoc.docx")
  

• 直接获取粘贴后的图片对象
  依赖InlineShapes.Count获取最新插入对象可能出错，改用PasteSpecial的返回值直接绑定：

  ' 替换原粘贴和对象赋值代码
  Set objInlineShape = doc.Bookmarks("Punktetabelle2").Range.PasteSpecial( _
      DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine)
  

• 解除图片纵横比锁定
  若图片LockAspectRatio为True，单独设置宽高可能冲突，先解锁再调整尺寸：

  With objInlineShape
      .LockAspectRatio = False
      .Width = 574
      .Height = 667
  End With
  

• 验证书签有效性
  书签Punktetabelle2可能已丢失或位置异常，添加存在性检查：

  If Not doc.Bookmarks.Exists("Punktetabelle2") Then
      MsgBox "书签Punktetabelle2不存在，请检查文档"
      Exit Sub
  End If
  

• 清空剪贴板缓存
  剪贴板异常可能导致粘贴格式错误，复制前清空剪贴板：

  Application.CutCopyMode = False
  Tabelle1.Range("Punktetabelle").Copy
  

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