[英]Using Excel VBA to Copy MS Word bookmark range and Paste into Excel
I am writing a macro in Excel (2010) to copy the value of 3 bookmarks from Word (2010) and paste them into a certain Excel Range. 我正在Excel(2010)中编写宏,以从Word(2010)复制3个书签的值并将其粘贴到某个Excel Range中。
I've found several similar questions here and on other various forums however most are macros in Word and don't have the correct references for what I need. 我在这里和其他各种论坛上都发现了几个类似的问题,但是大多数都是Word中的宏,并且没有我需要的正确参考。
Please note I will be using this to grab a Name, Date and Integer from multiple documents (approx. 200) which all have the same bookmarks. 请注意,我将使用它从多个具有相同书签的多个文档(大约200个)中获取名称,日期和整数。 This will be run at different times depending on when I assess the contents of the document and mark them as completed.
根据我评估文档内容并将其标记为完成的时间,此操作将在不同的时间运行。
To give a quick rundown of what the macro should do: 快速概述宏应该做什么:
Here is my current code (and below this is my list of issues): 这是我当前的代码(下面是我的问题列表):
Private Sub cmdImport_Click()
Dim intDocCount As Integer
Dim wdApp As Word.Application, wdDoc As Word.Document, xlWb As Excel.Workbook, xlWs As Excel.Worksheet
Set wdApp = Word.Application
Set wdDoc = ActiveDocument
Set xlWb = ThisWorkbook 'Edited from ActiveWorkbook
Set xlWs = ActiveWorkbook.Sheets("Sheet1")
intDocCount = Word.Application.Documents.Count
If intDocCount = 1 Then
GoTo Import
ElseIf intDocCount > 1 Then
MsgBox "There are " & intDocCount & " Word Documents open." & vbNewLine & vbNewLine & _
"Please close the additional MS Word Documents", vbCritical, "Too many Word Documents open!"
Exit Sub
ElseIf intDocCount < 1 Then 'Currently shows Runtime Error 462 rather than MsgBox
MsgBox "There are no MS Word Documents open.", vbInformation, "No Word Documents open"
Exit Sub
End If
Import:
With wdApp
wdDoc.Activate
wdDoc.Bookmarks("test").Range.Select
wdDoc.Copy 'Run-time error '438' here
End With
With xlWb
xlWs.Activate
xlWs.Cells(2, 1) = Selection
xlWs.Paste
End With
End Sub
So as indicated in the code, the second ElseIf
statement returns Runtime Error '462' "The remote server machine does not exist or is unavailable" rather than the vbInformation
message, 因此,如代码中所示,第二条
ElseIf
语句返回运行时错误'462'“远程服务器计算机不存在或不可用”,而不是vbInformation
消息,
AND 和
As long as there is 1 word document open I receive the following: 只要打开一个Word文档,我就会收到以下信息: "Run-time error '13': Type mismatch". “运行时错误'13':类型不匹配”。
Also a Run-time error '438' is present on the wdDoc.Copy
line 在
wdDoc.Copy
行上还存在运行时错误'438'
Unfortunatley I haven't found any other questions/answers that cover this specific scenario nor have I been able to Frankenstein some code together. 不幸的是,我还没有找到其他涉及此特定场景的问题/答案,也没有我能够一起进行科学怪人的代码编写。
EDIT: Set xlWb = ThisWorkbook
was changed from Set xlWb = ActiveWorkbook
which fixed Run-time error '13'. 编辑:
Set xlWb = ThisWorkbook
已从Set xlWb = ActiveWorkbook
更改,后者修复了运行时错误'13'。
Added info regarding Run-time error '438'. 添加了有关运行时错误“ 438”的信息。
Please try it like this... 请这样尝试...
Private Sub cmdImport_Click()
Dim intDocCount As Integer
Dim wdApp As Word.Application, wdDoc As Word.Document, xlWb As Excel.Workbook, xlWs As Excel.Worksheet
Dim BookmarkText As String
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0
If wdApp Is Nothing Then
MsgBox "There are no MS Word Documents open.", vbInformation, "No Word Documents open"
Exit Sub
End If
Set xlWb = ThisWorkbook 'Edited from ActiveWorkbook
Set xlWs = ActiveWorkbook.Sheets("Sheet1")
intDocCount = wdApp.Documents.Count
If intDocCount > 1 Then
MsgBox "There are " & intDocCount & " Word Documents open." & vbNewLine & vbNewLine & _
"Please close the additional MS Word Documents", vbCritical, "Too many Word Documents open!"
Set wdApp = Nothing
Exit Sub
End If
With wdApp
Set wdDoc = wdApp.ActiveDocument
wdDoc.Activate
BookmarkText = wdDoc.Bookmarks("test").Range.Text
End With
xlWs.Cells(2, 1) = BookmarkText
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.