VBA - 將數據從MS Word表格拖入MS Excel工作表（不是特殊的粘貼）

Question

我有一個包含幾個數據表（名稱，dob，地址等）的標準word文檔。

我想要有一個設置，所以當數據是新的輸入或改變的Word文檔，它會自動過濾到我的Excel文檔。我知道這可以使用「特殊粘貼」來完成，但我想知道是否可以採取其他方式。我知道基本的VBA，因爲我可以通過我的Word文檔中的按鈕打開並保存電子表格......但就是這樣。

任何意見，非常歡迎....一直在努力與此一段時間了。這可能就是我爲老式工作而工作的公司。

因此，要重述詞doc是信息的中心樞紐，Excel文檔需要從word 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