从单词内复制并粘贴图片作为命名的excel范围

我坚持为单词编码一个命令button。 button(在word文档中)需要调用一个对话框来指定excel工作簿的文件名,然后复制一个已命名的范围并将其粘贴回单词中作为图片。 复制和粘贴部分相当简单,但获取文件名对话框不适合我。

几乎每一个我发现的例子都指定了代码中的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 

在Word VBA中相当于Excel的Application.GetOpenFilenameApplication.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