Excel VBA实现Excel数据导入Word并设置部分文本格式

需求说明 #

需通过Excel VBA将Excel中B、C、D、E列的数据导入至Word表格，要求将B列文本设置为加粗并指定颜色（如B2为红色加粗，B3为蓝色加粗），C列文本保持常规格式，组合为「[B列内容] at [C列内容]」后换行显示D列内容，E列内容单独填入对应单元格。

示例数据 #

Excel表格包含列：ID、Case Type、Location、Description、Case handle by

• 第2行数据：S001、Lost and Found、1st Floor Lobby、A wallet was found、Alan
• 第3行数据：S002、Property Damaged、2nd Floor Lobby、The defected floor tiles was found.、Keith

预期Word表格效果 #

• 第1行第2列：Lost and Found（红色加粗） at 1st Floor Lobby（常规黑色），换行显示A wallet was found
• 第1行第3列：填入Alan
• 第2行：整行留空
• 第3行第2列：Property Damaged（蓝色加粗） at 2nd Floor Lobby（常规黑色），换行显示The defected floor tiles was found.
• 第3行第3列：填入Keith

待修正VBA代码 #

With table(1) 
     Column B2.characters(Start:=1, Length:=Column B2).Font.FontStyle = "Bold"
     Column B2.characters(Start:=1, Length:=Column B2).Font.ColorIndex = wdRed
     .cell(1, 1).Range.Text = (Column B2) & " at " & (Column C2) & Chr(13) & (Column D2)
     .cell(1, 2).Range.Text = (Column E2)
     .cell(1, 3).Range.Text = ""

     Column B3.characters(Start:=1, Length:=Column B3).Font.FontStyle = "Bold"
     Column B3.characters(Start:=1, Length:=Column B3).Font.ColorIndex = wdBlue
     .cell(1, 4).Range.Text = (Column B3 (Bold & Blue)) & " at " & (Column C3) & Chr(13) & (Column D3)
     .cell(1, 5).Range.Text = (Column E3)
     .cell(1, 3).Range.Text = ""
End with 

修正后的VBA代码及说明 #

原代码存在语法错误（如单元格引用方式错误、格式拼接逻辑无效、单元格索引不匹配预期结构），以下是可运行的修正版本：

Sub ExportToWordTable()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim wdTable As Object
    Dim ws As Worksheet
    Dim b2Len As Integer, b3Len As Integer
    
    ' 初始化Word对象
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    Set wdDoc = wdApp.Documents.Add
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' 替换为你的目标工作表名称
    
    ' 创建符合预期结构的3行3列表格
    Set wdTable = wdDoc.Tables.Add(Range:=wdDoc.Range, NumRows:=3, NumColumns:=3)
    
    ' 处理第2行Excel数据（S001）
    b2Len = Len(ws.Range("B2").Value)
    With wdTable.Cell(1, 2).Range
        .Text = ws.Range("B2").Value & " at " & ws.Range("C2").Value & vbCrLf & ws.Range("D2").Value
        ' 给B2内容设置红色加粗
        .Characters(Start:=1, Length:=b2Len).Font.Bold = True
        .Characters(Start:=1, Length:=b2Len).Font.ColorIndex = 3 ' wdRed对应ColorIndex=3
    End With
    wdTable.Cell(1, 3).Range.Text = ws.Range("E2").Value
    ' 合并第2行所有单元格实现留空
    wdTable.Cell(2, 1).Merge wdTable.Cell(2, 3)
    
    ' 处理第3行Excel数据（S002）
    b3Len = Len(ws.Range("B3").Value)
    With wdTable.Cell(3, 2).Range
        .Text = ws.Range("B3").Value & " at " & ws.Range("C3").Value & vbCrLf & ws.Range("D3").Value
        ' 给B3内容设置蓝色加粗
        .Characters(Start:=1, Length:=b3Len).Font.Bold = True
        .Characters(Start:=1, Length:=b3Len).Font.ColorIndex = 5 ' wdBlue对应ColorIndex=5
    End With
    wdTable.Cell(3, 3).Range.Text = ws.Range("E3").Value
    
    ' 释放对象
    Set wdTable = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Set ws = Nothing
End Sub

核心修正点 #

• 改用ws.Range("B2")的正确格式引用Excel单元格，替代原代码错误的Column B2写法
• 先写入完整文本内容，再通过Characters方法定位B列内容的范围设置格式（直接拼接带格式文本无法生效）
• 匹配预期的3行3列表格结构，修正原代码中不存在的单元格索引（如.cell(1,4)）
• 使用vbCrLf实现换行，比Chr(13)兼容性更好
• 合并第2行单元格实现整行留空的效果
• 用Word颜色索引值（红色3、蓝色5）替代可能未定义的wdRed/wdBlue常量

内容的提问来源于stack exchange，提问作者user1445998