使用vba从XLS文档复制到word

Question

我试图使一个代码，其中复制图表从一个xls文件到一个word文档使用PasteSpecial属性(图片(增强元文件)。我想把文档中现有的图表改为新的所以，我认为对现有的图表使用书签是可以的。我用的是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