通过下拉列表从Excel循环将文本插入到Word

Sub InsertTextToWord()
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim ExcelRange As Range
    Dim Cell As Range
    
    ' 创建一个新的Word应用程序
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True ' 可见性设置为True，方便调试
    
    ' 打开一个现有的Word文档或创建一个新的文档
    Set WordDoc = WordApp.Documents.Add
    
    ' 设置Excel中的范围，包括下拉列表的单元格
    Set ExcelRange = ThisWorkbook.Sheets("Sheet1").Range("A1:A10") ' 修改为实际的范围
    
    ' 循环遍历下拉列表中的每个选项
    For Each Cell In ExcelRange
        ' 将选项的值插入到Word文档中
        WordDoc.Content.InsertAfter Cell.Value & vbCrLf ' 修改为实际的插入位置
        
        ' 插入换行符，以便下一个选项插入到新的一行
        WordDoc.Content.InsertParagraphAfter
    Next Cell
    
    ' 保存并关闭Word文档
    WordDoc.SaveAs "C:\Path\To\Your\Word\File.docx" ' 修改为实际的保存路径和文件名
    WordDoc.Close
    
    ' 关闭Word应用程序
    WordApp.Quit
    
    ' 释放对象变量
    Set WordDoc = Nothing
    Set WordApp = Nothing
End Sub