从 Excel 电子表格运行 Word 文档中的 VBA 代码

Question

我有一个 Word 文件，其中包含一段可通过单击按钮激活的 VBA 代码工作片段。此 VBA 代码有一些对话框询问用户文件名并对这些文件中的数据进行一些操作。

我现在需要通过单击 Excel 中的按钮来运行此 Word VBA 代码。我希望 Excel 文件中的代码能够有效地模拟现在在 Word 文件中单击按钮的操作。

下面的代码不会执行行

Application.Run

。

' Make it compulsory to declare all variables

Option Explicit

Private Sub CommandButton1_Click()
    
    Dim strFile As String
    Dim oAPP As Object
    Dim chooseColumn As Variant

    Set oAPP = CreateObject(Class:="Word.Application")

    oAPP.Visible = True
    strFile = "Coding of Survey Answers.docm"
    
    'Display a Dialog Box that allows to select a single file.
    'The path for the file picked will be stored in fullpath variable
    MsgBox " Select the file " & strFile  
    With Application.FileDialog(msoFileDialogFilePicker)
        
        'Makes sure the user can select only one file
        .AllowMultiSelect = False
        
        'Filter to just the following types of files to narrow down selection options
        .Filters.Add "Word Files", "*.docx; *.doc; *.docm", 1
 'Show the dialog box
 
        If .Show <> -1 Then
            MsgBox "Error - could find the file " & strFile & " Retry"
            Else
        End If
         
        'Store in strFile variable
        strFile = .SelectedItems.Item(1)
  
        oAPP.Documents.Open Filename:=strFile
  
        Application.Run "CommandButton1_Click()"
        
        ' This is where the code for the Excel Part will have to go

        ' First Clear data in tables in this document
        'CodeFile = ActiveDocument.FullName
        'Documents.Open CodeFile
        'Documents(CodeFile).Activate
        'Tabnum = ActiveDocument.Tables.Count
        
        chooseColumn = InputBox("Into which Column to wish to past this data?")
        MsgBox chooseColumn
    
    End With
End Sub

Answer 1

您想使用单词对象来运行模块，而不是Application.Run命令。 Application.Run指的是excel，使用的应用程序，但你想运行一个word app宏：所以将其更改为oAPP.run“CommandButton1_Click()”

'Make it compulsory to declare all variables

Option Explicit

Private Sub CommandButton1_Click()
    Dim strFile As String
    Dim oAPP As Object
    Dim chooseColumn As Variant

    Set oAPP = CreateObject(Class:="Word.Application")

    oAPP.Visible = True
    strFile = "Coding of Survey Answers.docm"
    
    'Display a Dialog Box that allows to select a single file.
'The path for the file picked will be stored in fullpath variable

        MsgBox " Select the file " & strFile
        
        With Application.FileDialog(msoFileDialogFilePicker)
        
'Makes sure the user can select only one file

        .AllowMultiSelect = False
        
'Filter to just the following types of files to narrow down selection options
        
        .Filters.Add "Word Files", "*.docx; *.doc; *.docm", 1
 'Show the dialog box
 
        If .Show <> -1 Then
            MsgBox "Error - could find the file " & strFile & " Retry"
            Else
        End If
         
 'Store in strFile variable
 
        strFile = .SelectedItems.Item(1)
  
    oAPP.Documents.Open Filename:=strFile
  
'CHANGED LINE HERE:
    oAPP.Run "CommandButton1_Click()"
   

' This is where the code for the Excel Part will have to go

' First Clear data in tables in this document

        'CodeFile = ActiveDocument.FullName
        'Documents.Open CodeFile
        'Documents(CodeFile).Activate
        'Tabnum = ActiveDocument.Tables.Count
        
    chooseColumn = InputBox("Into which Column to wish to past this data?")
    MsgBox chooseColumn
    
End With
End Sub

Answer 2

您没有回答澄清问题...它的目的是配置代码以运行特定文档中的过程。不同的文档中可能存在多个

CommandButton1

，您需要调用相应的。因此，我将尝试展示一种通用代码，该代码能够搜索已经打开的 Word 会话，如果存在，则在打开的文档之间进行搜索（如果打开了必要的文档），如果没有任何已打开的会话，则打开一个新文档和必要的文档。如果您需要多次运行该子程序，那么每次运行它时都打开一个新会话是不合适的。

1.通常，

CommandButton

代码保留在

ThisDocument

代码模块中，创建为

Private Sub  CommandButton1_Click()

。你首先必须成功

Public

！

Public Sub CommandButton1_Click()
    '... whatever to be done...
End Sub

2. 通过以下方式从 Excel 调用它：

Sub RunSubFromWord()
  Dim objW As Word.Application, d As Word.Document
  
  Const strDocMacro As String = "C:\Teste VBA Excel\Word VBA\Test Word VBA.docm"

  On Error Resume Next
   Set objW = GetObject(, "Word.Application") 'get the Word open session
   If err.number <> 0 Then 'if no any Word ope session:
     err.Clear
     Set objW = CreateObject("Word.Application") 'open a Word new session
     objW.Visible = True 'to see it and avoid remaining between the running processes...
     Set d = objW.Documents.Open(strDocMacro)    'open the document having the necessary macro
   End If
  On Error GoTo 0

  If d Is Nothing Then
    For Each d In objW.Documents 'identify the necessary doc, if already open
        If d.fullname = strDocMacro Then Exit For
    Next d

    If d Is Nothing Then _
       Set d = objW.Documents.Open(strDocMacro) 'if not already open, open it.
  End If
  
  'run the procedure existing on the NECESSARY document:
  objW.Run "'" & d.fullname & "'!ThisDocument.CommandButton1_click" 'it works...
End Sub