从 Excel 循环下拉列表向 Word 插入文本

Question

我想用下拉列表中每个区域的 Excel table 列中的 3 个数字填充 Word 模板（我在此示例中简化了任务）。模板非常简单，如下所示：对于区域 1，6 月 21 日的估计值为“D6”，体积为“D7”，方差为“D8（百分比）”。请看下图。

解释：

我在下拉列表中有 3 个选项（区域），对于每个选项，table 中的值都会发生变化。我需要为下拉列表中的每个区域（区域 1、区域 2、区域 3）复制列中的数字，并且应该将它们复制到同一 Word 文档中的一个段落中，一个段落在另一个段落下方，一个用于区域1，一个用于区域 2 等（参见上面的模板）。

D2 中的值根据星期手动更改，例如，如果 D2 中的值为 14，则应在 C 列等中插入数字。

注意 1：我尝试使用邮件合并，但下拉列表和我的数据格式无法实现。

下面是我目前得到的代码。该代码的灵感来自于这个问题的答案：Excel-VBA; Copy data from excel and paste it in to a word template at different places

我是 VBA 的新手，到目前为止我只知道如何从一个文件中插入文本我和 Region 需要做三个 Region 的任务才能得到三个段落。

Sub PasteStuffIntoWord()
Dim ws As Worksheet
Dim TextToPaste As String
Dim objWord As Object
Dim objSelection As Object

Set ws = Worksheets("Sheet1")
With ws
    TextToPaste = " For Region 1, on June, 21 the estimate was " & .Range("D6").Text & _
    " and the volume was " & .Range("D7").Text & _
    " and the variance was  " _
    & .Range("D8").Text
End With

    Set objWord = CreateObject("word.Application")
    objWord.Documents.Open "C:Test.docx"
    objWord.Visible = True
    Set objSelection = objWord.Selection
    objSelection.TypeText TextToPaste

End Sub

Answer 1

试试这个代码：

Option Explicit

Sub Export()
    Dim objWord As Object, doc As Object, reg As Variant
    
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True  'optional, but better not
    
    With ThisWorkbook.Sheets("Sheet 1")
        For Each reg In Array("Region1", "Region2", "Region3")
            .Range("B3") = reg
            .Calculate
            
            Set doc = objWord.Documents.Add 'Open("C:\Test.docx")
            
            doc.Range.Text = " For Region 1, on June, 21 the estimate was " & .Range("D6").Text & _
            " and the volume was " & .Range("D7").Text & _
            " and the variance was  " _
            & .Range("D8").Text
            
            doc.SaveAs "C:\temp\" & reg & ".docx"  ' your path and name
            doc.Close False
        Next
    End With
    
    objWord.Quit
End Sub

编辑2

Sub Export()
    Dim reg As Variant, col As String, txt As String
    
    With ThisWorkbook.Sheets("Sheet 1")
        For Each reg In Array("Region1", "Region2", "Region3")
            .Range("B3") = reg
            .Calculate
            
            col = IIf(.Range("D2").Value = 14, "C", "D")    'select column due to D2 value
            
            ' collect all texts in txt
            txt = txt & vbTab & "For " & reg & ", on June, 21 the estimate was " & _
            .Range(col & "6").Text & " and the volume was " & .Range(col & "7").Text & _
            " and the variance was  " & .Range(col & "8").Text & vbLf
        Next
    End With
    
    With CreateObject("Word.Application").Documents.Add
        .Range.Text = txt    ' output all text to the document
        .SaveAs "C:\temp\AllTheText.docx"  ' your path and name
        .Parent.Quit    'quit Word
    End With
End Sub

从 Excel 循环下拉列表向 Word 插入文本

Insert text to Word from Excel looping through drop down list

excel

vba

ms-word

编辑2