【问题标题】:from within word, copy and paste as picture a named excel range从word中,复制并粘贴为图片命名的excel范围
【发布时间】:2017-02-06 15:22:25
【问题描述】:

我一直在为 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 

【问题讨论】:

  • 您刚刚更改了整个邮政编码吗?我把它滚到你以前的帖子里,如果这个问题得到了回答,那么标记为答案。然后,打开一个新帖子,包含您的新请求并添加您修改过的代码,否则帖子将永远不会在这里关闭
  • 我建议您参观一下,了解如何在 SO 上提出问题以及如何获得答案,就在这里stackoverflow.com/tour
  • 这真的是张贴图片吗?看起来它可能会粘贴链接或格式化文本,但不会粘贴图像。
  • 感谢@Shai Rado,辛苦了! @S Meaden,还没有,但当前版本可以。

标签: excel vba ms-word


【解决方案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

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2023-03-08
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多