如何从Excel调用Word宏

Question

I have two macros, one in Excel, and one in Word. The Excel Macro calls the Word macro. My code is as follows:

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

And word:

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

My problem is that the variable wb1 isn't getting passed between them. Even though I put wb1 in the list of variables to send to the macro, when it arrives at the document, wb1 has no value inside of it. I would re-initialize it, but I don't know how to refer to an already existing document - only how to set it equal to one as you open it.

So either how do I pass the value through into the Word macro, or how do I re-initialize this variable? Preferably without having to set something equal to the excel application, because every time I try that it sets it equal to Excel 2003, not 2010 (though any solutions to that are also, of course, welcome).

Thanks!

Answer 1

You can't use the Excel global objects from inside of Word without explicitly qualifying them (they simply don't exist there). In particular, that means you can't use Sheets . You should also explicitly declare the variable types of your parameters - otherwise they'll be treated as Variant . This is important with reference types because in that it helps prevent run-time errors because the compiler knows that the Set keyword is required.

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

Note - you also don't need to pass dt1 at all. You never use the value in the parameter and actually set it to something else. This could be a source of errors if you're using internal calls, because dt1 is implicitly passed ByRef (it gets boxed when you call it through Application.Run ). That means whenever you call divider , whatever you pass to dt1 in the calling code will change to ThisDocument . You should either remove the parameter or specify that it is ByVal .

Answer 2

Borrowed from another SO link.

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