VBA-将数据从MS Word表提取到MS Excel工作表中（没有特殊粘贴）

Question

我有一个标准的Word文档，其中包含一些数据表（名称，文件，地址等）。

我想进行设置，以便在Word文档中新输入或更改数据时将其自动过滤到我的excel文档中。 我知道可以使用“特殊粘贴”来完成此操作，但是我想知道是否可以执行其他任何方式。 我知道基本的VBA，因为我可以从Word文档中的按钮打开并保存电子表格...。仅此而已。

任何建议都非常欢迎。。。已经为此苦苦挣扎了一段时间。 可能只是我为老式服务的公司。

因此，概括一下doc这个词是信息的中心，而excel doc需要从doc这个词中获取更新的信息。

Answer 1

这是我上述评论的进一步内容。 该代码的作用是循环遍历表行中的每个单元格，并提取可直接放入Excel单元格的文本，从而无需使用Copy-Paste

我已经注释了代码，因此您在理解它时应该没有任何问题。 如果您仍然这样做，则只需回发。

您需要将此代码粘贴到模块中，并在每次要将表数据导出到Excel时运行它。

不用说我还没有完全测试这段代码。

Sub Sample()
    Dim wrdTbl As Table
    Dim RowCount As Long, ColCount As Long, i As Long, j As Long

    '~~> Excel Objects
    Dim oXLApp As Object, oXLwb As Object, oXLws As Object

    '~~> Set your table
    Set wrdTbl = Selection.Tables(1)

    '~~> Get the word table Row and Column Counts
    ColCount = wrdTbl.Columns.Count
    RowCount = wrdTbl.Rows.Count

    '~~> Create a new Excel Applicaiton
    Set oXLApp = CreateObject("Excel.Application")

    '~~> Hide Excel
    oXLApp.Visible = False

    '~~> Open the relevant Excel file
    Set oXLwb = oXLApp.Workbooks.Open("C:\Sample.xls")
    '~~> Work with Sheet1. Change as applicable
    Set oXLws = oXLwb.Sheets(1)

    '~~> Loop through each row of the table
    For i = 1 To RowCount
        '~~> Loop through each cell of the row
        For j = 1 To ColCount
            '~~> This gives you the cell contents
            Debug.Print wrdTbl.Cell(i, j).Range.Text

            '~~> Put your code here to export the values of the Word Table
            '~~> cell to Excel Cell. Use the .Range.Text to get the value
            '~~> of that table cell as shown above and then simply put that
            '~~> in the Excel Cell
            With oXLws
                '~~> EXAMPLE
                ' .Cells(1, 1).Value = wrdTbl.Cell(i, j).Range.Text
            End With
        Next
    Next

    '~~> Close and save Excel File
    oXLwb.Close savechanges:=True

    '~~> Cleanup (VERY IMPROTANT)
    Set oXLws = Nothing
    Set oXLwb = Nothing
    oXLApp.Quit
    Set oXLApp = Nothing

    MsgBox "DONE"
End Sub

Answer 2

我曾经做过一次，这里是基础知识，对不起，代码是葡萄牙语，但我将用英语对其进行评论。 这里的主要功能是通过标题和名称轻松获取表值。 （无需翻译代码）

'opens word and loads tables
Sub AbreWordDatabase()

    Set WordApp = CreateObject("Word.Application")  'creates word application in a variable declared as global outside this method
    WordApp.Visible = True                          'shows word

    'opens dialog box
    If WordApp.Dialogs(80).Show = -1 Then        'shows fileopendialog
        Set Doc = WordApp.Documents(1)           'sets the open document to a previously declared variable
        WordApp.WindowState = 2                  'minimizes o word (2 = wdWindowStateMinimize)
        LoadDataBase                             'takes desired values in file
    Else
        MsgBox "Word file wasnt open, operation was canceled."
    End If

    WordApp.Quit
    Set WordApp = Nothing

End Sub

---

Sub LoadDataBase()  'Takes values in word file        

    SelectTabela "Title"                            'selects a table below the passed title
    Plan3.Range("NamedRange").Value = PegaValor("Some variable name - Line", "Some column name")    'Puts in excel table the value of first column after the passed variable name
    Plan3.Range("NamedRange2").Value = PegaValor("Another variable", "Another column name")    

End Sub

---

'Selects in Word the table below "Titulo"
Sub SelectTabela(Titulo As String, Optional NumTabela As Integer = 1)

    'Titulo = Title that comes before the desired table in word file
    'NumTabela = defines if the desired table is the first below title, or second, third.... 

    Dim i As Integer

    PegaTexto(Titulo, Doc.Content, 12, True).Select 'Finds the title using the title formatting of table titles (customize this for your needs)
    For i = 1 To NumTabela                          'This loop finds below title the tables one by one until the desired number
        WordApp.Selection.GoToNext (2)              'goes to next table (2 = wdGoToTable)
    Next

End Sub

---

'Finds a value in table using variable name and passed column    
Function PegaValor(NomeVar As String, Coluna As Variant) As String

    'Parameters
        'NomeVar = name of the variable in the selected table corresponding to the desired value
        'Coluna = index of the column after the name of the variable, or the name of the column

    Dim LinVar As Integer, ColVar As Integer    'Row and column indices to find the line based on variable name
    Dim LinCol As Integer, ColCol As Integer    'Row and column indices to find the column based on column name
    Dim Tabela As Object                        'Word.Table object - table where the values will be searched

    Set Tabela = WordApp.Selection.Range.Tables(1)  'Takes selected table


    AchaLinhaColuna NomeVar, Tabela, LinVar, ColVar   'Gives LinVar and ColVar the indices of the cell where the variable name was found (NomeVar)
    If LinVar = 0 Or ColVar = 0 Then                    ' 'If row or column are zero, variable was not found in table
        MsgBox "The name """ & NomeVar & """ passed to function ""PegaValor"" wasn't found"
        Exit Function
    End If

    If VarType(Coluna) = vbString Then                          'Verifies if type of var in column is string

        AchaLinhaColuna Coluna, Tabela, LinCol, ColCol, ColVar  'Gives LinCol and Colcol the indices of the cell where "Coluna" is found. Remember the searched region is after "ColVar". Colvar is for the case there are repeated names in different columns, we want the values only after the desired name
        If LinVar = 0 Or ColVar = 0 Then                        'If line or column are zero, column wasn't found by name.
            MsgBox "The name of the column """ & Coluna & """ passed to the function ""PegaValor"" wasn't found"
            Exit Function
        End If

    Else
        ColCol = ColVar + Coluna                                'The value of the searched column is the column containing the variable name plus the quantity of columns after that, passed to this function
    End If


    PegaValor = Tabela.Cell(LinVar, ColCol).Range.Text  'Takes the text of the cell of row corresponding to var name and column corresponding to the passed column name or index
    PegaValor = Left(PegaValor, Len(PegaValor) - 2)     'Eliminates the two last characters, they are special characters coming from word table.

End Function

---

'Returns line and column in a table where given text is found
Sub AchaLinhaColuna(ByVal Texto As String, ByVal Tabela As Object, ByRef L As Integer, ByRef C As Integer, Optional ByVal StartC As Integer = 1)

    'Parameters consumed
        'Texto = desired text to be found in table
        'Tabela = table where text will be searched (Word.Table)
        'StartC = Start column from where value will be searched (for tables with repeated columns, starts the search in the desired column)

    'Parameters passed as results (marked byref)
        'L = line of the cell where text has been found
        'C = column of the cell where text has been found


    Dim j As Integer                'Loop indices
    Dim Linha As Object             'Table row (Word.Row)

    For Each Linha In Tabela.Rows   'For each table line
        For j = StartC To Linha.Cells.Count   'For each cell in that line starting from desired column (StartC)

            With Linha.Cells(j)         'With cell in row "Linha" and column j
                If UCase(PegaTexto(Texto, .Range).Text) = UCase(Texto) Then   'If text in cell is the desired text returns line and column
                    L = .Row.Index      'Row index
                    C = .Column.Index   'Column Index
                    Exit Sub
                End If
            End With

        Next
    Next
End Sub

---

'Finds and returns any text in Word file. May use formatting.
Function PegaTexto(Texto As String, FindWhere As Object, Optional FontSize As Integer = 0, Optional Negrito As Boolean = False) As Object '(Word.Range)

    'Parameters consumed
        'Texto = Desired text to find
        'FindWhere = Range of the word file where text will be searched. (Range: Word's API object containing parts of the document, beware, there are ranges in excel, they are different) (Word.Range)
        'FontSize = desired font size (if no value is passed, assume any size)
        'Negrito = defines if desired text is bold (if no value is passed, assumes any formatting)

    With FindWhere.Find     'Find: Word's API object that finds text

        .ClearFormatting    'At start clears all formatting
        .Text = Texto       'Sets the desired text to be found
        With .Font          'WIth the font of the Find object - sets the font and bold formatting

            If FontSize <> 0 Then   
                .Size = FontSize   
            End If
            If Negrito Then         
                .Bold = True        
            End If

        End With
        .Execute        'Executes the Find object

    End With

    Set PegaTexto = FindWhere  'The Find object transforms the FindWhere range, making it contain only the found text

End Function