Вызов Sub VBA Word с аргументами из Excel VBA - PullRequest
Новая
       29

Вызов Sub VBA Word с аргументами из Excel VBA

3 голосов
/ 02 марта 2012

У меня есть очень простая подпрограмма Word в шаблоне dotm: 

Sub YHelloThar(msg As String)
    MsgBox (msg)
End Sub

У меня тогда есть подпрограмма Excel: 

Sub CallWordSub()
        Dim wdApp As Word.Application
        Dim newDoc As Word.Document

        'Word template location   
        strFile = "C:\Some\Folder\MyWordDoc.dotm"
        'Get or create Word application
        Set wdApp = GetObject(, "Word.Application")
        If wdApp Is Nothing Then
            Set wdApp = CreateObject("Word.Application")
        End If
        'Create new Word doc from template
        Set newDoc= wdApp.Documents.Add(strFile)
        'Call the YHelloThar sub from the word doc
        Call wdApp.Run(strFile & "!YHelloThar", "Hello")
    End If
End Sub

В последней строке отображается сообщение «Ошибка времени выполнения« 438 »: объект не поддерживает это свойство или метод».

Я не уверен, что я делаю неправильно - все, что я посмотрел, указывает на то, что это правильный способ выполнять вызовы из разных приложений.

Кроме того, если я изменю последнюю строку на вызов без параметров, он внезапно будет работать правильно.

1 Ответ

6 голосов
/ 02 марта 2012

ПРОВЕРЕНО И ИСПЫТАНО 

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

Также у вас есть дополнительный End If в конце. Опечатка, наверное?

СОВЕТ : чтобы избежать ошибок во время выполнения, вам придется обработать ошибку непосредственно перед вызовом 

Set wdApp = GetObject(, "Word.Application")

ПОСЛЕДУЮЩИЙ МОЙ СОВЕТ

Вот пример. Также я использовал Позднее связывание, чтобы оно работало с каждой версией Office. 

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
...