VBA复制Word表格至Excel时项目符号丢失，求代码修改方案

你当前的代码只提取了Word单元格的纯文本，完全忽略了段落的项目符号或编号格式，导致这些标记在Excel中丢失。下面是直接修改核心逻辑的方案，能快速保留这些内容：

修改后的核心代码段 #

替换原代码中Cells(resultRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)所在的循环，改用以下逻辑：

For iRow = 1 To .Rows.Count
    For iCol = 1 To .Columns.Count
        Dim wordCell As Word.Cell
        Set wordCell = .Cell(iRow, iCol)
        Dim para As Word.Paragraph
        Dim cellText As String
        cellText = ""
        
        ' 遍历单元格内的每个段落，提取项目符号/编号+文本
        For Each para In wordCell.Range.Paragraphs
            Dim listMark As String
            ' 获取段落的项目符号或编号字符串
            listMark = para.ListFormat.ListString
            ' 拼接符号和段落文本，清理多余格式字符
            cellText = cellText & listMark & WorksheetFunction.Clean(para.Range.Text) & vbCrLf
        Next para
        
        ' 移除最后多余的换行符，写入Excel单元格
        If Len(cellText) > 0 Then
            Cells(resultRow, iCol) = Left(cellText, Len(cellText) - 2)
        End If
    Next iCol
    resultRow = resultRow + 1
Next iRow

关键逻辑说明 #

• 遍历Word单元格内的每个段落：项目符号/编号是绑定在段落上的，不是整个单元格，必须逐段落处理
• para.ListFormat.ListString：直接获取Word段落的项目符号（比如●）或编号（比如1.、a.），无需自行判断格式
• 用vbCrLf拼接多个段落，保证Excel单元格内的换行结构和Word一致

完整的循环代码 #

把这段代码替换你原有的循环部分即可：

For tableStart = tableNo To tableTot
    With .tables(tableStart)
        For iRow = 1 To .Rows.Count
            For iCol = 1 To .Columns.Count
                Dim wordCell As Word.Cell
                Set wordCell = .Cell(iRow, iCol)
                Dim para As Word.Paragraph
                Dim cellText As String
                cellText = ""
                
                For Each para In wordCell.Range.Paragraphs
                    Dim listMark As String
                    listMark = para.ListFormat.ListString
                    cellText = cellText & listMark & WorksheetFunction.Clean(para.Range.Text) & vbCrLf
                Next para
                
                If Len(cellText) > 0 Then
                    Cells(resultRow, iCol) = Left(cellText, Len(cellText) - 2)
                End If
            Next iCol
            resultRow = resultRow + 1
        Next iRow
    End With
    resultRow = resultRow + 1
Next tableStart

这个方案仅在原代码基础上扩展了段落遍历逻辑，无需额外引用复杂对象，能快速解决项目符号/编号丢失的问题。

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