excel - 我想从word中提取段落并将其导入到excel电子表格中的单元格中，保留项目符号和字母

Question

我需要获取一个 Word 文档并将其段落(硬中断)导出到 Excel 电子表格中的单个单元格中，同时保留项目符号和字母以及文本、表格和图表。

我认为 VBA 将是最好的方法。

我用的是office 2007。

Answer 1

像这样的东西？

Sub ReadContenttoExcel()
Dim DocPara As Paragraph

' work with the new excel workbook
    Dim oXL As Excel.Application
    Dim oWB As Excel.Workbook
    Dim oSheet As Excel.Worksheet
    Dim oRng As Excel.Range
    Dim ExcelWasNotRunning As Boolean
    Dim WorkbookToWorkOn As String
    Dim xxRow, xxCol As Integer
    'specify the workbook to work on
    WorkbookToWorkOn = "D:\test.xlsx"
    xxRow = 1
    xxCol = 1

    'If Excel is running, get a handle on it; otherwise start a new instance of Excel
    On Error Resume Next
    Set oXL = GetObject(, "Excel.Application")

    If Err Then
       ExcelWasNotRunning = True
       Set oXL = New Excel.Application
    End If


    'Open the workbook
    Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
    Set oSheet = oWB.Sheets(1)
    oSheet.Activate


    ' Parameters for testing -- see whats happening
    With oXL
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
        .Visible = True
    End With


    'Run through the Document and Save each of the Heading 1 Texts to Excel

        For Each DocPara In ActiveDocument.Paragraphs

            Select Case (DocPara.Range.Style)
                Case "Heading 1"
                    'Debug.Print "Heading1~" & Left(DocPara.Range.Text, Len(DocPara.Range.Text) - 1)
                    xxRow = xxRow + 1
                    oSheet.Cells(xxRow, 1).Value = Left(DocPara.Range.Text, Len(DocPara.Range.Text) - 1)
                Case "Heading 2"
                    oSheet.Cells(xxRow, 2).Value = Left(DocPara.Range.Text, Len(DocPara.Range.Text) - 1)
                Case "Heading 3"
                    oSheet.Cells(xxRow, 3).Value = Left(DocPara.Range.Text, Len(DocPara.Range.Text) - 1)
                Case "Heading 4"
                    oSheet.Cells(xxRow, 4).Value = Left(DocPara.Range.Text, Len(DocPara.Range.Text) - 1)
                Case Else
                    oSheet.Cells(xxRow, 5).Value = Left(DocPara.Range.Text, Len(DocPara.Range.Text) - 1)
           End Select
           xxRow = xxRow + 1
        Next

      ActiveWorkbook.Save
      If ExcelWasNotRunning Then
        oXL.Quit
      End If

    'Realease the Object References
    Set oRng = Nothing
    Set oSheet = Nothing
    Set oWB = Nothing
    Set oXL = Nothing 
End Sub