使用vba從xls文檔復制到word

Question

我正在嘗試創建一個代碼，使用PasteSpecial屬性（圖片（增強型圖元文件）將圖表從xls文件復制到word文檔。我想將文檔的現有圖表更改為新圖表。所以，我我認為使用現有圖表的書簽可以。我正在使用OFFICE 2007。

我寫了以下代碼：

        Dim YMApp As Word.Application
        Dim YMDoc As Word.Document
        Dim B as Bookmark
        paaath = "D:\"
        dime = "NameOld.doc"
        dime2 = "NameNew.doc"
        Set YMApp = New Word.Application
        YMApp.Visible = True
        Set YMDoc = YMApp.Documents.Open(paaath & dime)
        Word.Documents(dime).SaveAs (paaath + dime2)
        For k = 1 To 6
            Windows("New.xls").Activate
            Sheets("graph").Select
            Range("L" + Trim(Str(br(k))) + ":V" + Trim(Str(br(k) + 24))).Select
            Selection.Copy
            ddd = "bm" + Trim(Str(k))
            Set B = YMDoc.Bookmarks(ddd)
            YMApp.Selection.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=B
        Next k
        YMDoc.Close
        YMApp.Quit
        Application.CutCopyMode = False
        ActiveWorkbook.Close
    End
End Sub

問題在於，通過此代碼，無法識別已創建的書簽。 如何應對這個問題？

Answer 1

PasteSpecial的Placement參數不接受Bookmark對象：

Set B = YMDoc.Bookmarks(ddd)
YMApp.Selection.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=B

相反，它需要一個WdOLEPlacement常量 。

我認為您需要在執行PasteSpecial之前選擇書簽。 您可能還需要刪除現有圖表（如果有）。

未經測試，但我認為你需要這樣的東西：

Dim wdRange as Word.Range
Set B = YMDoc.Bookmarks(ddd)
Set wdRange = B.Range

YMApp.Selection.GoTo What:=wdGoToBookMark, Name:=B.Name

' Delete existing shapes & bookmark if any:
On Error Resume Next
YMDoc.ShapeRange(1).Delete
wdRange.Delete
On Error GoTo 0
YMApp.Selection.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=0 'Or 1

'Add the bookmark back in place:
MDoc.Selection.Bookmarks.Add Name:=ddd, wdRange