通过 Excel VBA 在 MS Word 中运行连续潜艇答案

【问题标题】：Running consecutive subs in MS Word via Excel VBA通过 Excel VBA 在 MS Word 中运行连续潜艇
【发布时间】：2020-09-15 18:03:03
【问题描述】：

我是 VBA 的新手，并尝试使用内容控件将 Excel 表单中的数据导出到 MS Word 报价单中。我在网上找到了这个 vba 代码，它得到了我想要的东西，但是每次我应用 sub 时脚本都会打开和关闭 word 文档。我希望它们连续运行，直到最后的保存命令。
你能帮我运行第二个子而不是每次都关闭和打开word文档吗

谢谢昏暗

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 & "/" & Range("O1").Value & ".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 & "/" & Range("O1").Value & ".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

【问题讨论】：

标签： excel

【解决方案1】：

    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 & "/" & Range("O1").Value & ".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

【讨论】：

嘿，谢谢拉迪什。工作一种享受