excel - 从 Word 中复制并粘贴为图片命名的 Excel 范围

Question

我在为 word 编写一个命令按钮时遇到了困难。该按钮(在Word文档中)需要调用一个对话框来指定Excel工作簿的文件名，然后复制命名范围并将其作为图片粘贴回Word中。复制和粘贴部分相当简单，但获取文件名对话框对我来说不起作用。

我发现的几乎每个示例都在代码中指定了 excel 文件名，而不是来自对话框

到目前为止我的代码(尝试尽可能地清理它，有很多尝试和错误)

Sub CRA_copy()

Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim oRng As Excel.Range
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String
Dim dlgOpen As FileDialog
Dim crabook As String

oName = ActiveDocument.Name

'If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")

If Err Then
   ExcelWasNotRunning = True
   Set oXL = New Excel.Application
End If

On Error GoTo Err_Handler

'Open the workbook     
 crabook = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=False)

'Process each of the spreadsheets in the workbook
oXL.ActiveWorkbook.Range("CRA").Copy

If ExcelWasNotRunning Then
    oXL.Quit
End If

oName.Activate

Selection.EndKey Unit:=wdStory
Document.InsertBreak Type:=wdPageBreak

Selection.Paste
'Make sure you release object references.
Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing

'quit
Exit Sub

Err_Handler:
    MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, _
    "Error: " & Err.Number
If ExcelWasNotRunning Then
    oXL.Quit
End If

End Sub 

Answer 1

在 Word VBA 中，与 Excel 的 Application.GetOpenFilename 等效的是 Application.FileDialog。

尝试下面的代码:

Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)

' modify the FileDialog settings
With dlgOpen
     'Add a filter that includes .xl* (.xls, .xlsx, .xlsm)
    .Filters.Add "Excel Files (*.xl*)", "*.xl*"
    .AllowMultiSelect = False
    .Show

    crabook = .SelectedItems(1)
End With