从Word到Excel导入特定数据 [英] Importing specific data from a Word to Excel
本文介绍了从Word到Excel导入特定数据的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
https://www.dropbox.com/s/ ivikt9qwy4nmz69 / Sample1.docx
解决方案
我做了一次，这里是基础，对不起代码是在葡萄牙语，但我会用英语评论。这里的主要功能是通过标题和名称轻松获取表格值。 （不需要代码转换）
我的代码从表中获取文本，但一旦了解其工作方式，您将能够根据您的需要进行自定义
您需要在项目中添加对Word API的引用。
'打开单词并加载表
Sub AbreWordDatabase（）
设置WordApp = CreateObject（Word.Application）'在声明为全局之外的变量中创建单词应用程序
WordApp.Visible = True'显示单词
'打开对话框
如果WordApp.Dialogs（80）.Show = -1然后'显示fileopendialog
设置文档= WordApp.Documents（1）'将打开的文档设置为先前声明的变量
WordApp.WindowState = 2'最小化o单词（2 = wdWindowStateMinimize）
LoadDataBase'在文件
中使用所需的值其他
MsgBoxWord文件未打开，操作已取消。
如果
WordApp.Quit
设置WordApp =没有
End Sub
Sub LoadDataBase（）'在字文件中获取值 - 一些例子使用excel工作表和单元格
SelectTabela标题选择传递的标题下的表
Sheet3.Range（NamedRange）。Value = PegaValor（Some variable name-Line 一些列名）'在Excel表中输入变量名后的第一列的值
Sheet3.Range（A1）。Value = PegaValor（另一个变量，另一个列名称）
Sheet1.Cells（1,1）.Value = PegaValor（One More，Foo）
ThisWorkBook.WorkSheets（Sheetname）。Range（C2）。Value = PegaValor（One More，Foo）
End Sub
'在Word中选择Titulo
Sub SelectTabela（Titulo As String，可选NumTab ela As Integer = 1）
'Titulo =在文件文件中所需表之前的标题
'NumTabela =定义所需表是否是第一个下面的标题，或第二个或第三个。 ...
Dim i As Integer
PegaTexto（Titulo，Doc.Content，12，True）。选择'使用表标题的标题格式查找标题（自定义这个为你的需要）
对于i = 1到NumTabela'这个循环查找下面的表一个一个直到所需的数字
WordApp.Selection.GoToNext（2）'转到下一个表（2 = wdGoToTable）
下一个
End Sub
'使用变量名查找表中的值并传递列
函数PegaValor（NomeVar As String，Coluna As Variant）As String
'参数
'NomeVar =所选表中对应于所需值的变量的名称
'Coluna =变量名称后面的列的索引，或列的名称
Dim LinVar As Integer，ColVar As Integer'行和列索引，以找到基于变量名的行
Dim LinCol As Integer，ColCol As Integer'根据列名称找到列的行和列索引
Dim Tabela作为对象的Word.Table对象 - 将搜索值的表
设置Tabela = WordApp.Selection.Range.Tables（1）'选择表
AchaLinhaColuna NomeVar，Tabela，LinVar，ColVar'为LinVar和ColVar提供单元格的索引找到变量名称（NomeVar）
如果LinVar = 0或ColVar = 0 Then''如果行或列为零，则表$ b中没有找到变量$ b MsgBox名称& NomeVar& 传递给函数没有找到PegaValor
退出函数
如果
如果VarType（Coluna）= vbString然后'验证var类型在列中是字符串
AchaLinhaColuna Coluna，Tabela，LinCol，ColCol，ColVar'为LinCol和Colcol提供了发现Coluna的单元格的索引。记住搜索的区域是在ColVar之后。对于这种情况，Colvar是不同列中重复的名称，我们只需要在所需名称之后的值
如果LinVar = 0或ColVar = 0则'如果行或列为零，则列名称未找到。
MsgBox列的名称& Coluna& 传递给函数PegaValor未找到
退出函数
结束如果
Else
ColCol = ColVar + Coluna'的搜索列是包含变量名称的列加上该列之后的数量，传递给此函数
End If
PegaValor = Tabela.Cell（LinVar，ColCol ）.Range.Text'获取对应于通过列名或索引的var名称和列对应的行的单元格的文本
PegaValor = Left（PegaValor，Len（PegaValor） - 2）'消除最后两个字符，它们是来自单词表的特殊字符。
结束功能
'返回表中给定文本的行和列
Sub AchaLinhaColuna（ByVal Texto As String，ByVal Tabela As Object，ByRef L As Integer，ByRef C As Integer，Optional ByVal StartC As Integer = 1）
'参数消耗
'Texto =要在表中找到的所需文本
'Tabela =要搜索文本的表（Word.Table）
'StartC =从搜索值开始的列（对于具有重复列的表，在所需列中开始搜索）
'作为结果传递的参数（由ref标记）
'L =找到文本的单元格行
'C =已找到文本的单元格列
Dim j As Integer'循环索引
Dim Linha As Object'Table row（Word.Row）
对于每个Linha在Tabela.Rows'对于每个tabl e line
对于j = StartC To Linha.Cells.Count'对于从所需列（StartC）开始的该行中的每个单元格
带有Linha.Cells（j）'带行单元格Linha和列j
如果UCase（PegaTexto（Texto，.Range）.Text）= UCase（Texto）然后'如果单元格中的文本是所需的文本返回行和列
L = .Row .Index'行索引
C = .Column.Index'列索引
退出子
结束如果
结束
下一个
下一个
End Sub
code>'查找并返回Word文件中的任何文本。可以使用格式化。
函数PegaTexto（Texto As String，FindWhere As Object，可选FontSize As Integer = 0，可选Negrito As Boolean = False）As Object'（Word.Range）
'参数消耗
'Texto =要找到的文本
'FindWhere =要搜索文本的单词文件的范围。 （范围：Word的API对象包含文档的部分，请注意，excel中有范围，它们不同）（Word.Range）
'FontSize =所需的字体大小（如果没有值传递，假定任何大小）
'Negrito =定义所需文本是否为粗体（如果没有值传递，假定任何格式）
FindWhere.Find'Find：Word的API对象，找到文本
.ClearFormatting'开始时清除所有格式
.Text = Texto'设置要找到的所需文本
With .Font'查找对象的字体 - 设置字体和粗体格式
如果FontSize<> 0然后
.Size = FontSize
End If
如果Negrito然后
.Bold = True
结束如果
结束
。执行'执行查找对象
结束
设置PegaTexto = FindWhere'Find对象转换FindWhere范围，使其仅包含找到的文本
结束功能
I have 6000 Word documents to work on. I need code to have a VBA copy the data in Word listed as a reference (below is a link to a sample) and paste it into an Excel file. The length of the documents will vary but the title "References" is always constant. Can this be accomplished?
https://www.dropbox.com/s/ivikt9qwy4nmz69/Sample1.docx
解决方案
I did that once, here are the basics, sorry for the code is in portuguese, but I'll comment it in english. The main feature here is the easyness to get table values by their titles and names. (there's no need for code translating)
My code was getting text from tables, but once you understand the way it works, you will be able to customize it for your purposes.
You will need to add a Reference to Word API to your project.
'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 - some examples of how to use excel sheets and cells
SelectTabela "Title" 'selects a table below the passed title
Sheet3.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
Sheet3.Range("A1").Value = PegaValor("Another variable", "Another column name")
Sheet1.Cells(1,1).Value = PegaValor("One More", "Foo")
ThisWorkBook.WorkSheets("Sheetname").Range("C2").Value = PegaValor("One More", "Foo")
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
这篇关于从Word到Excel导入特定数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
