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

时间:2017-02-06 06:30:52

标签: excel vba ms-word word-vba

我卡住了一个单词命令按钮。按钮(在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 

1 个答案:

答案 0 :(得分:0)

在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