Question

在EXCEL宏中，我想将所选范围复制到WORD文档表中。我知道该怎么做，创建一个新的WORD文档（目标）。但是我想检查是否已经打开了WORD文档，可以从中选择目标。

我发现了从EXCEL-Macro内部循环访问所有打开的EXCEL-Applications的代码。我从 Florent Breheret 中修改了code，如下所示。

缺少的类名称是什么，用“ ???”表示在代码中查找WORD文档？

先谢谢您！伊曼纽尔

Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long

Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
    ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, _
    ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr

'Test my code
Private Sub GetWordInstances_Test()
    Dim wd As Word.Application
    Dim i, cnt As Integer

    cnt = 0
    For Each wd In GetWordInstances()
        cnt = cnt + 1
        Debug.Print wd.Application.Name, cnt

        For i = 1 To wd.Documents.Count

            Debug.Print wd.Documents(i).FullName, i
        Next i
    Next
End Sub

'Getting open WORD instances from within EXCEL-VBA
Public Function GetWordInstances() As Collection
    Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
    guid(0) = &H20400
    guid(1) = &H0
    guid(2) = &HC0
    guid(3) = &H46000000

    Set GetWordInstances = New Collection
    Do
        hwnd = FindWindowExA(0, hwnd, "OpusApp", vbNullString)
        If hwnd = 0 Then Exit Do

        hwnd2 = FindWindowExA(hwnd, 0, "???", vbNullString)

        hwnd3 = FindWindowExA(hwnd2, 0, "???", vbNullString)

        'hand over found WORD application to collection
        If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
            GetWordInstances.Add acc.Application
        End If
    Loop
End Function

Answer 1

这对我有用： 1.在Excel中添加引用：工具->参考-> Microsoft Word XX.X对象库 2.运行以下代码：

sub openDocs（）

Dim openDoc     As Word.Document
Dim docCount    As Long

docCount = Documents.Count

For Each openDoc In Documents
    'do whatever, i.e.:
    ' debug.print openDoc.Name
Next openDoc

If docCount = 0 Then
    MsgBox "There are no open documents."
Else
    MsgBox "There are " & docCount & " open documents."
End If

结束子

Answer 2

尝试这样的事情...

Sub CheckForWordApp()
Dim wApp As Object
On Error Resume Next
Set wApp = GetObject(, "Word.Application")
If Err.Number = 429 Then
    'Word application is not running so create it
    Set wApp = New Word.Application
    wApp.Visible = True
    'no documents will exist, so do something
Else
    'A Word application exists, make sure it's visible
    wApp.Visible = True
    If wApp.Document.Count > 0 Then
        'There are open documents so do something
    Else
        'No documents are open so do something else
    End If
End If
End Sub

Answer 3

请参阅此answer，其中介绍了解决问题的过程。

恢复：

OpusApp ==> _WwF ==> _WwB ==> _WwG.

您必须添加另一层：

    hwnd = FindWindowExA(0, hwnd, "OpusApp", vbNullString)
    If hwnd = 0 Then Exit Do

    hwnd2 = FindWindowExA(hwnd, 0, "_WwF", vbNullString)

    hwnd3 = FindWindowExA(hwnd2, 0, "_WwB", vbNullString)

    hwnd4 = FindWindowExA(hwnd3, 0, "_WwG", vbNullString)
    'hand over found WORD application to collection
    If AccessibleObjectFromWindow(hwnd4, &HFFFFFFF0, guid(0), acc) = 0 Then
        GetWordInstances.Add acc.Application
    End If

在VBA EXCEL-Macro中查找所有打开的Word应用程序

3 个答案: