أرغب في استخراج الفقرات من Word واستيرادها إلى الخلايا في جدول بيانات Excel حفظ أرقام ورصاصات

Question

أحتاج إلى أخذ مستند Word وتصدير فقراتها (استراحات صلبة) في خلايا واحدة في جدول بيانات Excel حفظ أرقام ورصاصة جنبا إلى جنب مع النص والجداول والرسوم البيانية.

أفترض أن VBA سيكون أفضل نهج.

أنا أستخدم Office 2007.

Answer 1

Something like this?

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

Save as .htm then open with excell.