VKK's questions

Tenho um script que classifica as tabelas no Word usando a ordem do Excel corretamente, mas depois de classificar as linhas, elas são excluídas.

Usei ctrl z para ver o que aconteceu passo a passo-

1. as linhas começaram a ser excluídas da última linha até a 3.
2. após a exclusão, as linhas começaram a ser adicionadas a partir da linha 3 na ordem correta, como eu queria.
3. depois que todas as linhas foram adicionadas na ordem correta, as linhas começaram a ser excluídas da última linha até a linha 3.

Por que as linhas começaram a ser deletadas depois que as linhas foram adicionadas em uma ordem adequada. Elas não devem ser deletadas depois que a classificação for feita, significa que as linhas foram adicionadas.

O que posso tentar em seguida?

Sub SortSelectedTablesUsingExcelOrder()

    Dim wdDoc As Document
    Dim wdTable As table
    Dim excelApp As Object
    Dim excelWorkbook As Object
    Dim excelSheet As Object
    Dim sortOrder() As String
    Dim i As Long, j As Long
    Dim cellValue As String
    Dim rowIndex As Long
    Dim newRow As row
    Dim colCount As Long
    Dim fileDialog As fileDialog
    Dim filePath As String
    Dim lastRow As Long
    Dim matchedRows As Collection
    Dim rowText As Variant
    Dim tableCellValue As String

    Set wdDoc = ActiveDocument

    ' File selection dialog for Excel file
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    With fileDialog
        .Title = "Select the Excel File"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm", 1
        .AllowMultiSelect = False
        If .Show = -1 Then
            filePath = .SelectedItems(1)
        Else
            MsgBox "No file selected. Exiting.", vbExclamation
            Exit Sub
        End If
    End With

    ' Initialize Excel application
    Set excelApp = CreateObject("Excel.Application")
    excelApp.Visible = False
    Set excelWorkbook = excelApp.Workbooks.Open(filePath)
    Set excelSheet = excelWorkbook.Sheets(2)

    lastRow = excelSheet.Cells(excelSheet.Rows.Count, 1).End(-4162).row

    ' Load Excel order into sortOrder array
    ReDim sortOrder(1 To lastRow)
    For i = 1 To lastRow
        sortOrder(i) = UCase(excelSheet.Cells(i, 1).Value) ' Convert to uppercase
        Debug.Print "Excel Order " & i & ": " & sortOrder(i) ' Print Excel order in Immediate Window
    Next i

    ' Process Word tables
    For Each wdTable In wdDoc.Tables
        If UCase(Trim(wdTable.cell(1, 1).Range.Text)) Like "*PARTS REQUIRED*" Then ' Convert table title to uppercase
            colCount = wdTable.Columns.Count
            Set matchedRows = New Collection

            ' Gather matched rows from the Word table
            For i = 1 To lastRow
                cellValue = sortOrder(i)
                Debug.Print "Processing Excel Value: " & cellValue ' Print currently processing Excel value

                For rowIndex = 3 To wdTable.Rows.Count
                    tableCellValue = UCase(Left(wdTable.cell(rowIndex, 1).Range.Text, Len(wdTable.cell(rowIndex, 1).Range.Text) - 2)) ' Convert to uppercase

                    If tableCellValue = cellValue Then
                        rowText = ""

                        ' Collect the data from the matched row
                        For j = 1 To colCount
                            rowText = rowText & wdTable.cell(rowIndex, j).Range.Text & vbTab
                        Next j
                        rowText = Left(rowText, Len(rowText) - 1)
                        matchedRows.Add rowText

                        ' Print matched row
                        Debug.Print "Matched Row " & rowIndex & ": " & rowText
                    End If
                Next rowIndex
            Next i

            ' Now, clear the table and add the rows back in the correct order
            For rowIndex = wdTable.Rows.Count To 3 Step -1
                wdTable.Rows(rowIndex).Delete
            Next rowIndex

            ' Insert rows back based on the matched order
            For Each rowText In matchedRows
                Set newRow = wdTable.Rows.Add

                Dim rowData() As String
                rowData = Split(rowText, vbTab)

                For j = 1 To colCount
                    newRow.Cells(j).Range.Text = rowData(j - 1)
                Next j

                ' Print new row data after insertion
                Debug.Print "Inserted Row: " & Join(rowData, vbTab)
            Next rowText
        End If
    Next wdTable

    ' Clean up the Word table content
    For Each wdTable In wdDoc.Tables
        tableTitle = UCase(Trim(wdTable.cell(1, 1).Range.Text)) ' Convert title to uppercase
        tableTitle = Left(tableTitle, Len(tableTitle) - 2)

        If tableTitle = "PARTS REQUIRED" Then
            For Each tableCell In wdTable.Range.Cells
                tableCell.Range.Text = Replace(tableCell.Range.Text, vbCr, "")
            Next tableCell
        End If
    Next wdTable

    ' Close Excel
    excelWorkbook.Close SaveChanges:=False
    excelApp.Quit
    Set excelApp = Nothing
    Set excelWorkbook = Nothing
    Set excelSheet = Nothing
    Set wdDoc = Nothing

End Sub