如何从Excel调用Word宏

Question

我有两个宏，一个在Excel中，一个在Word中。 Excel宏调用Word宏。 我的代码如下：

Excel中：

Public wb1 As Workbook
Public dt1 As Document

Sub openword()
Dim wpath, epath As String      'where the word document will be opened and where the excel sheet will be saved
Dim wordapp As Object           'preparing to open word
Set wb1 = ThisWorkbook

While wb1.Sheets.Count <> 1
    wb1.Sheets(2).Delete
Wend

wpath = "C:\users\GPerry\Desktop\Projects and Work\document.docm"
Set wordapp = CreateObject("Word.Application")
'Set wordapp = CreateObject(Shell("C:\Program Files (x86)\Microsoft Office\Office14\WINWORD", vbNormalFocus)) this is one I tried to make work because while word.application seems to work, I don't *understand* it, so if anyone can help, that'd be awesome
wordapp.Visible = True
Set dt1 = wordapp.Documents.Open(wpath)
wordapp.Run "divider", wb1, dt1
dt1.Close
wordapp.Quit
End Sub

并且说：

Sub divider(wb1, dt1)
Set dt1 = ThisDocument
If dt1.Paragraphs.Count > 65000 Then
    Set cutrange = dt1.Range(dt1.Paragraphs(1).Range.Start, dt1.Paragraphs(65000).Range.End)
    If wb1.Sheets(Sheets.Count).Cells(1, 1) <> "" Then
        wb1.Sheets.Add After:=Sheets.Count
    End If
Else
    Set cutrange = dt1.Content
    If wb1.Sheets(Sheets.Count).Cells(1, 1) <> "" Then
        wb1.Sheets.Add After:=Sheets.Count
    End If
End If
    cutrange.Cut Destination:=wb1.Sheets(wb1.Sheets(Sheets.Count)).Cells(1, 1)
    wb1.Sheets(Sheets.Count).Cells(1, 1).TextToColumns Destination:=wb1.Sheets(1).Cells(1, 1)
End Sub

我的问题是变量wb1没有在它们之间传递。 即使我将wb1放在要发送到宏的变量列表中，当它到达文档时，wb1内部没有值。 我会重新初始化它，但我不知道如何引用已经存在的文档 - 只有在打开它时如何将其设置为等于1。

那么我如何将值传递到Word宏中，或者如何重新初始化此变量？ 最好不必设置与excel应用程序相同的东西，因为每次我尝试将它设置为等于Excel 2003，而不是2010（尽管任何解决方案当然也是受欢迎的）。

谢谢！

Answer 1

您无法在不明确限定它们的情况下使用Word内部的Excel全局对象（它们根本就不存在）。 特别是，这意味着您无法使用Sheets 。 您还应该显式声明参数的变量类型 - 否则它们将被视为Variant 。 这对于引用类型很重要，因为它有助于防止运行时错误，因为编译器知道需要Set关键字。

Sub divider(wb1 As Object, dt1 As Document)
    Set dt1 = ThisDocument
    If dt1.Paragraphs.Count > 65000 Then
        Set cutrange = dt1.Range(dt1.Paragraphs(1).Range.Start, dt1.Paragraphs(65000).Range.End)
        If wb1.Sheets(wb1.Sheets.Count).Cells(1, 1) <> "" Then
            wb1.Sheets.Add After:=wb1.Sheets.Count
        End If
    Else
        Set cutrange = dt1.Content
        If wb1.Sheets(wb1.Sheets.Count).Cells(1, 1) <> "" Then
            wb1.Sheets.Add After:=wb1.Sheets.Count
        End If
    End If
    cutrange.Cut Destination:=wb1.Sheets(wb1.Sheets(wb1.Sheets.Count)).Cells(1, 1)
    wb1.Sheets(wb1.Sheets.Count).Cells(1, 1).TextToColumns Destination:=wb1.Sheets(1).Cells(1, 1)
End Sub

注意 - 您根本不需要传递dt1 。 您永远不会在参数中使用该值，并实际将其设置为其他值。 如果您正在使用内部调用，这可能是错误的来源，因为dt1隐式传递ByRef （当您通过Application.Run调用它时它会被装箱）。 这意味着无论何时调用divider ，在调用代码中传递给dt1任何内容都将更改为ThisDocument 。 您应该删除参数或指定它是ByVal 。

Answer 2

借用另一个SO链接。

Sub Sample()
    Dim wdApp As Object, newDoc As Object
    Dim strFile As String

    strFile = "C:\Some\Folder\MyWordDoc.dotm"

    '~~> Establish an Word application object
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set wdApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    wdApp.Visible = True

    Set newDoc = wdApp.Documents.Add(strFile)

    Call wdApp.Run("YHelloThar", "Hello")

    '
    '~~> Rest of the code
    '
End Sub