從單詞中復制並粘貼為圖片命名的excel范圍

Question

我卡住了一個單詞命令按鈕。 按鈕（在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