Почему комбинированный код VBA работает только с задержкой (встроенный шаблон Word в Excel)? - PullRequest
0 голосов
/ 07 февраля 2019

С помощью Cindy Meister был получен код для записи во встроенный шаблон MS Word в Excel.После этого два отдельных шаблона Word были вставлены в книгу Excel.Я пытался вызывать их один за другим отдельным макросом («Кнопка 3»).После нажатия («Кнопка 3») и успешного запуска «Code one (« Button 1 »)» я получил ошибку, и отладчик указал на objOLE.Verb xlOpen.Я заметил, что после некоторого ожидания я смог запустить второй код («Кнопка 2»), нажимая кнопки вручную («Кнопка 2») после («Кнопка 1»).Поэтому я решил проблему задержки между двумя кодами, и она, кажется, работает.

Кто-нибудь может описать, почему между двумя кодами необходима задержка?

Я пробовал это на разных компьютерах сразличные установки MS Office с одинаковым результатом.Если нет:

DoEvents
Application.Wait (Now + TimeValue("00:00:30"))

При получении ошибки отладчик указывает на секунды, код objOLE.Verb xlOpen

Код один («Кнопка 1»):

Sub opentemplateWord1()
    Dim sh As Shape
    Dim objWord As Object, objNewDoc As Object ''Word.Document
    Dim objOLE As OLEObject
    Dim wSystem As Worksheet
    Dim cell As Range
Dim xlRng As Excel.Range
Dim xlSht As Worksheet
Dim wdRng As Object 'Word.Range

    Set wSystem = Worksheets("Templates")
    ''The shape holding the object from 'Create from file'
    ''Object 2 is the name of the shape
    Set sh = wSystem.Shapes("Template1")
    ''The OLE Object contained
    Set objOLE = sh.OLEFormat.Object
    'Instead of activating in-place, open in Word
    objOLE.Verb xlOpen
    Set objWord = objOLE.Object 'The Word document

    Dim objUndo As Object 'Word.UndoRecord
   'Be able to undo all editing performed by the macro in one step
    Set objUndo = objWord.Application.UndoRecord
    objUndo.StartCustomRecord "Edit In Word"

    With objWord
        .Bookmarks.Item("Date").Range.Text = ThisWorkbook.Sheets("Main").Range("K5").Value
        .Bookmarks.Item("DocumentName").Range.Text = ThisWorkbook.Sheets("Main").Range("K6").Value
        .Bookmarks.Item("ProjectNumber").Range.Text = ThisWorkbook.Sheets("Main").Range("K7").Value

With xlSht
  Set xlRng = Sheets("Data").Range("D3", Sheets("Data").Range("D" & Rows.Count).End(xlUp))
End With

Set wdRng = .Range.Characters.Last

Set xlSht = Sheets("Data")
  For Each cell In xlRng
    wdRng.InsertAfter vbCr & cell.Offset(0, -1).Text
     Select Case LCase(cell.Value)
        Case "title"
          wdRng.Paragraphs.Last.Style = .Styles("Heading 1")
        Case "main"
          wdRng.Paragraphs.Last.Style = .Styles("Heading 2")
        Case "normal"
          wdRng.Paragraphs.Last.Style = .Styles("Data")
    End Select
  Next cell

  Set xlSht = Nothing


        objWord.SaveAs2 ActiveWorkbook.Path & "\" & _
        Sheets("Data").Range("C3").Value & ".docx"

        objUndo.EndCustomRecord
        Set objUndo = Nothing
        objWord.Undo
        .Application.Quit False
Set objOLE = Nothing

    End With
    Set objWord = Nothing
    Worksheets("Main").Activate
End Sub

Код 2 («Кнопка 2»):

Sub opentemplateWord2()
    Dim sh As Shape
    Dim objWord As Object, objNewDoc As Object ''Word.Document
    Dim objOLE As OLEObject
    Dim wSystem As Worksheet
    Dim cell As Range
    Dim xlRng As Excel.Range
Dim xlSht As Worksheet
Dim wdRng As Object 'Word.Range

    Set wSystem = Worksheets("Templates")
    ''The shape holding the object from 'Create from file'
    ''Object 2 is the name of the shape
    Set sh = wSystem.Shapes("Template2")
    ''The OLE Object contained
    Set objOLE = sh.OLEFormat.Object
    'Instead of activating in-place, open in Word
    objOLE.Verb xlOpen
    Set objWord = objOLE.Object 'The Word document

    Dim objUndo As Object 'Word.UndoRecord
   'Be able to undo all editing performed by the macro in one step
    Set objUndo = objWord.Application.UndoRecord
    objUndo.StartCustomRecord "Edit In Word"

    With objWord
        .Bookmarks.Item("Date").Range.Text = ThisWorkbook.Sheets("Main").Range("K5").Value
        .Bookmarks.Item("DocumentName").Range.Text = ThisWorkbook.Sheets("Main").Range("K6").Value
        .Bookmarks.Item("ProjectNumber").Range.Text = ThisWorkbook.Sheets("Main").Range("K7").Value

With xlSht
  Set xlRng = Sheets("Data").Range("G3", Sheets("Data").Range("G" & Rows.Count).End(xlUp))
End With

Set wdRng = .Range.Characters.Last

Set xlSht = Sheets("Data")
  For Each cell In xlRng
    wdRng.InsertAfter vbCr & cell.Offset(0, -1).Text
     Select Case LCase(cell.Value)
        Case "title"
          wdRng.Paragraphs.Last.Style = .Styles("Heading 1")
        Case "main"
          wdRng.Paragraphs.Last.Style = .Styles("Heading 2")
        Case "normal"
          wdRng.Paragraphs.Last.Style = .Styles("Data")
    End Select
  Next cell

  Set xlSht = Nothing

        objWord.SaveAs2 ActiveWorkbook.Path & "\" & _
        Sheets("Data").Range("F3").Value & ".docx"

        objUndo.EndCustomRecord
        Set objUndo = Nothing
        objWord.Undo
        .Application.Quit False

    End With
    Set objWord = Nothing

    Worksheets("Main").Activate
End Sub

Все вместе («Кнопка 3»):

Sub doeverythingsecondapproach()

Call opentemplateWord1
DoEvents
Application.Wait (Now + TimeValue("00:00:30"))
Call opentemplateWord2
DoEvents
Application.Wait (Now + TimeValue("00:00:30"))

Worksheets("Main").Activate

End Sub

Здесь - это файл, если вы неЯ не хочу воспроизводить его самостоятельно.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...