將圖片插入InlineShape

Question

我正在寫一份文件，其中我必須包含許多圖片。 在正在進行的過程中，圖片會多次更改。

我的想法是將Rectangle Shapes用作占位符，並為其指定一個合適的名稱。 我創建了一個宏來選擇Shape，刪除舊圖片並將新圖片插入到Shape中。

Sub InsertImage(Shape As String, Picture As String, Hight As Integer)
    Dim shp As Word.Shape
    Dim strFile As String
    Dim strExt As String

    strFile = "C:\Pictures"
    strExt = ".png"

    ActiveDocument.Shapes.Range(Array(Shape)).Select
    Selection.TypeBackspace
    Set shp = ActiveDocument.Shapes.AddPicture(Anchor:=Selection.Range, FileName:= _
         strFile & "\" & Picture & strExt, LinkToFile:=False, SaveWithDocument:=True)
    With shp
        .LockAspectRatio = msoTrue
        .Height = CentimetersToPoints(Hight)
    End With 
End Sub


Sub Insert1()
    InsertImage "Shape01", "Pic01", 10
End Sub

我想要用於浮動Shapes和InlineShapes。

當我將占位符形狀設置為InlineShapes時，TypeBackspace行將刪除InlineShape，並且圖片不會插入到InlineShape中。

Answer 1

非常感謝你的幫助。 經過多次努力之后，使用Tables + Bookmarks的解決方案可以完成。 這是代碼：

Sub InsertPic(Pic As String, Cut As Single)
Dim strFile As String
Dim strExt As String
Dim ils As InlineShape

strFile = "C:\Pictures“
strExt = ".png"

Application.ScreenUpdating = False

ActiveDocument.Bookmarks(Pic).Select
Selection.Delete

Set ils = Selection.InlineShapes.AddPicture(FileName:= _
strFile & "/" & Pic & strExt, _
LinkToFile:=False, SaveWithDocument:=True)

    With ils
    .PictureFormat.CropBottom = CentimetersToPoints(Cut)
    .LockAspectRatio = msoTrue
    .Height = .Range.Cells(1).Height
    If .Width > .Range.Cells(1).Width Then
       .Width = .Range.Cells(1).Width
    End If
    End With

ActiveDocument.Bookmarks.Add (Pic)

Application.ScreenUpdating = True

End Sub


Sub Insert01()
InsertPic "Image01", 20
MsgBox "Done"
End Sub

一些解釋：

對於此代碼，書簽和圖片需要相同的名稱。 我這樣做是為了避免混淆。

使用Selection.Delete命令，Bookmark也會被刪除，所以我在最后添加了一個同名的新書簽。 我敢肯定有解決這個問題的更優雅的方法，但是這個解決方案是可行的。

我有很多掙扎，因為我想裁剪Picure。 但是當插入表格單元格后，尺寸會變為表格單元格的大小。 因此，Picturs無法滿足整個單元格的大小。 因此，我添加了一個部件來將Image的大小調整為table-cell Size。 同樣，我肯定有更好的方法來克服這個問題...

由於調整大小，萬客隆需要一些時間（至少對於我的文檔而言）。 所以我禁用了Screenupdating。