[英]Why does VBA come out of debug mode when ".paste" method is used to paste data from cell in MS Excel to a cell in a MS Word table?
[英]VBA - Pull data from MS Word table into MS Excel Worksheet (NOT special Paste)
我有一個標准的Word文檔,其中包含一些數據表(名稱,文件,地址等)。
我想進行設置,以便在Word文檔中新輸入或更改數據時將其自動過濾到我的excel文檔中。 我知道可以使用“特殊粘貼”來完成此操作,但是我想知道是否可以執行其他任何方式。 我知道基本的VBA,因為我可以從Word文檔中的按鈕打開並保存電子表格...。僅此而已。
任何建議都非常歡迎。。。已經為此苦苦掙扎了一段時間。 可能只是我為老式服務的公司。
因此,概括一下doc這個詞是信息的中心,而excel doc需要從doc這個詞中獲取更新的信息。
這是我上述評論的進一步內容。 該代碼的作用是循環遍歷表行中的每個單元格,並提取可直接放入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
我曾經做過一次,這里是基礎知識,對不起,代碼是葡萄牙語,但我將用英語對其進行評論。 這里的主要功能是通過標題和名稱輕松獲取表值。 (無需翻譯代碼)
'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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.