С помощью 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
Здесь - это файл, если вы неЯ не хочу воспроизводить его самостоятельно.