Блог

Я новичок в VBA и пытаюсь экспортировать данные из формы Excel в цитату MS Word, используя content control, в таблицы с одним столбцом. Я нашел этот код vba в Интернете, который дает мне то, что я хочу, однако скрипт открывает и закрывает документ Word каждый раз, когда я применяю подраздел. Я хочу, чтобы они выполнялись последовательно до последней команды сохранения.
Можете ли вы помочь мне запустить второй подраздел, не закрывая и не открывая документ Word каждый раз

Спасибо Dim

 Sub Service_Desc_toWord()

Dim wordApp As Word.Application
    Dim wDoc As Word.Document
    Dim r As Integer
    
    Set wordApp = CreateObject("word.application")
    Set wDoc = wordApp.Documents.Open(ThisWorkbook.Path amp; "/" amp; Range("O1").Value amp; ".docx")
    wordApp.Visible = True
    r = 43
    
    For i = 131 To 143
    
        wDoc.ContentControls(i).Range.Text = Sheets("Configuration").Cells(r, 4)
        'Sheets("Configuration").Cells(r,4)=wDoc.ContentCOntrols(i).Range.Text
        r = r   1
        
    Next i
    
    wordApp.Documents.Close
    wordApp.Quit
    Service_Qty_toWord
End Sub

Sub Service_Qty_toWord()

Dim wordApp As Word.Application
    Dim wDoc As Word.Document
    Dim r As Integer
    
    Set wordApp = CreateObject("word.application")
    Set wDoc = wordApp.Documents.Open(ThisWorkbook.Path amp; "/" amp; Range("O1").Value amp; ".docx")
    wordApp.Visible = True
    r = 43
    
    For i = 144 To 156
    
        wDoc.ContentControls(i).Range.Text = Sheets("Configuration").Cells(r, 1)
        'Sheets("Configuration").Cells(r,1)=wDoc.ContentCOntrols(i).Range.Text
        r = r   1
        
    Next i
    
    wordApp.ActiveDocument.SaveAs2 Filename:="Quote Letter", FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, CompatibilityMode:=15

End Sub
  

     Sub Service_Desc_toWord()
Dim wordApp As Word.Application
Dim wDoc As Word.Document
Dim r As Integer
Set wordApp = CreateObject("word.application")
Set wDoc = wordApp.Documents.Open(ThisWorkbook.Path amp; "/" amp; Range("O1").Value amp; ".docx")
wordApp.Visible = True
r = 43
For i = 131 To 143
wDoc.ContentControls(i).Range.Text = Sheets("Configuration").Cells(r, 4)
'Sheets("Configuration").Cells(r,4)=wDoc.ContentCOntrols(i).Range.Text
r = r   1
Next i
r = 43
For i = 144 To 156
wDoc.ContentControls(i).Range.Text = Sheets("Configuration").Cells(r, 1)
'Sheets("Configuration").Cells(r,1)=wDoc.ContentCOntrols(i).Range.Text
r = r   1
Next i
wordApp.ActiveDocument.SaveAs2 Filename:="Quote Letter", FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=15
wordApp.Documents.Close
wordApp.Quit
End Sub