Я хотел бы извлечь абзацы из слова и импортировать их в ячейки в таблице Excel, содержащей цифры и буквы маркеров

Question

Мне нужно взять текстовый документ и экспортировать его абзацы (жесткие разрывы) в отдельные ячейки в таблице 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

Answer 2

Сохранить как .htm, затем открыть с Excell.