时间:2015-08-11 17:18:41

标签: excel vba excel-vba ms-word

我目前有excel VBA代码打开一个表格,我可以选择一个Word文档。然后代码可以获得3个表中的一个。最后,倒数第二,第三到最后。这是有效的,因为我可以获得总表数,我需要的3个表总是文档中的最后一个。现在,允许用户在我需要的3之后添加表,所以我需要添加一些代码以确保我得到我想要的。这是我有问题的地方。

我的三个表是文档部分10.1,10.2和10.3中的唯一表。我不知道如何通过索引号告诉哪些表在这些文档部分中。有没有办法在Word文档10.1节中找到该表?

我目前的代码如下:

Public Sub Get_TP_101(allbool As Boolean)
    Dim wdDoc As Object
    Dim wdFileName As Variant
    Dim tableNo As Integer 'the table number the user selects
    Dim iRow As Long 'row index in Excel
    Dim iCol As Integer 'column index in Excel
    Dim resultRow As Long
    Dim tableStart As Integer
    Dim tableTot As Integer ' the total number of tables in Document
    Dim Ret As Variant
    Dim sFullFileName As String
    Dim pagenum As Integer
    On Error Resume Next

    wdFileName = Application.GetOpenFilename("Word files (*.doc*),*.doc*", , _
    "Browse for the Test Procedure containing table to be imported")

    If wdFileName = False Then Exit Sub '(user cancelled import file browser)

    Set wdDoc = GetObject(wdFileName) 'open Word file

    With wdDoc
        tableTot = wdDoc.tables.Count
        If tableTot = 0 Then
            MsgBox "This document contains no tables", _
            vbExclamation, "Import Word Table"
        ElseIf tableTot > 1 Then
            'tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
            "Enter the table to start from", "Import Word Table", "1")
            tableNo = tableTot - 2 '' get the third from last table by table index number
        End If

        resultRow = 1

        'For tableStart = 1 To tableTot
            With .tables(tableNo)
                'copy cell contents from Word table cells to Excel cells
                For iRow = 1 To .Rows.Count
                    For iCol = 1 To .Columns.Count
                        Worksheets("TP_10_1").Cells(resultRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
                    Next iCol
                    resultRow = resultRow + 1
                Next iRow
            End With
            resultRow = resultRow + 1
        'Next tableStart
    End With

    wdDoc.Close SaveChanges:=False

    ''Format
    Worksheets("TP_10_1").Range("A2:I5000").WrapText = True
    Worksheets("TP_10_1").Range("A2:I5000").VerticalAlignment = xlCenter
    Worksheets("TP_10_1").Range("A2:I5000").Borders.LineStyle = xlContinuous

    If allbool = False Then
        MsgBox ("Done import Table 10.1")
    End If

1 个答案:

答案 0 :(得分:0)

您可以尝试这样的事情 - 该函数将返回它在您提供的部分编号中找到的第一个表。

注意:该部分中必须至少有一个表,否则它可能会找到它找到的下一个表,这可能在以下部分中......

只有轻微测试,所以你需要做一些自己的测试!

Sub TestGettingTable()

    Dim tbl As Table
    Set tbl = GetATable(ThisDocument, "2.1")

    If Not tbl Is Nothing Then
        Debug.Print tbl.Cell(1, 1).Range.Text
    End If

End Sub


Function GetATable(d As Word.Document, listNum As String)

    Dim p As Paragraph, rng As Object, tbl As Object

    For Each p In d.Paragraphs
        If p.Style = "Heading 2" And p.Range.ListFormat.ListType = _
                                         wdListOutlineNumbering Then

            If p.Range.ListFormat.ListString = listNum Then

                Set rng = p.Range.GoTo(What:=wdGoToTable, Which:=wdGoToNext)
                If rng.Tables.Count > 0 Then
                    Set tbl = rng.Tables(1)
                    Exit For
                End If

            End If 'matches number
        End If 'is Heading 2
    Next p

    Set GetATable = tbl

End Function