Retrieve Values From MS Word Tables
2007-11-23
VBA provides limited ability to store and retrieve values. While the registry can be used for this purpose, it is not easily accessible by naive users. The purpose of these routines is to allow a user to type values in normal MS Word tables, where those values are later retrieved and used by VBA.
It is even possible to retrieve and write values from/to MS Word template files located in the users Startup folder; allowing a relatively straightforward method for users to configure VBA distributed via a .dot file located in the Startup folder.
This function checks cell (1,1) in each table of the specified document and returns a reference to the table that contains a specific value (called the TableNm) in cell (1,1).
TableNm—The text string to look for in cell (1,1); the table name. The string match is not case sensitive.
True—returned if a table with the name TableNm was found.
This function steps through the columns of the specified table looking for a specific value in the header row, and then returns the column number of the column containing that value.
RowNm—The text string to look for in the first cell of each row; the row name. The string match is not case sensitive.
True—returned if a column with the name RowNm was found.
This function steps through the rows of the specified table looking for a specific value in the first column, and then returns the row number of the row containing that value.
RowNm—The text string to look for in the first cell of each row; the row name. The string match is not case sensitive.
True—returned if a row with the name RowNm was found.
Return unformatted text from a specific cell in a table.
Table—The table containing the cell to access.
The unformatted text contained in (Cell_Row, Cell_Column) of the Table
Return the formatted text from a specific cell in a table.
Table—The table containing the cell to access.
The range containing the formatted text contained in (Cell_Row, Cell_Column) of the Table
Write an unformatted text string into a specific cell in a table.
Table—The table containing the cell to write.
To use this function, copy and paste this source code into a VBA module in the MS Word document in which you want to use the function; or download Retrieve From Tables v6.dot.
'''
' RetrieveFromTable - Retrieve Stored Values From Tables
'
' (c)2005-2007 Christopher Rath, all rights reserved.
'
' VBA provides limited ability to store and retrieve values. While
' the registry can be used for this purpose, it is not easily accessible
' by naive users. The purpose of these routines is to allow a user to
' type values in normal MS Word tables, where those values are later
' retrieved and used by VBA.
'
' It is even possible to retrieve values from MS Word template files
' (located in the users Startup folder); allowing a relatively
' straightforward method for users to configure VBA distributed via
' a .dot file located in the Startup folder.
'
' Permission is granted for any use of this template by others as long
' as this copyright statement is retained, other due and proper credit
' is provided to the author (e.g., don't claim you wrote this template),
' and the LGPL license is respected. This package is free software; you
' can redistribute it and/or modify it under the terms of the GNU Lesser
' General Public License as published by the Free Software Foundation;
' either version 2.1 of the License. See the LGPL license on the GNU.org
' website. This package is distributed in the hope that it will be
' useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE; on an “AS IS,”
' “WHERE IS” and “WITH ALL FAULTS” basis.
'
' Revision history:
' 2007-11-23 - v6
' Added SetCellText() function.
' 2005-12-31 - v5
' Added a parameter to FindColNum() that allows you to specify
' which row to use as the column heading row. We now also
' check to ensure that the row we are going to scan exists.
' 2005-12-28 - v4
' We now look for table, row, and column names in a non-case
' sensitive fashion.
' 2005-12-27 - v3
' Added FindColNum() function.
' 2005-12-26 - v2
' First public release.
' 2004-09-28 - v1
' Initial version; never publicly released.
'''
Option Explicit
Function FindTable(ByVal TableNm As String, _
ByRef WorkDoc As Document, _
ByRef TableReturn As Table) As Boolean
'
' FindTable Function
' This function checks cell (1,1) in each table of the specified document and returns
' a reference to the table that contains a specific value (called the TableNm) in
' cell (1,1).
' Parameters:
' TableNm - The text string to look for in cell (1,1); the table name.
' WorkDoc - The document containing the tables to check.
' TableReturn - A pointer to the table with the name TableNm.
' Return Values:
' True - returned if a table with the name TableNm was found.
' False - returned if no table with the name TableNm was found.
'
Dim aTable As Table
FindTable = False
For Each aTable In WorkDoc.Tables
If UCase(TableNm) = UCase(ReturnCellText(aTable, 1, 1)) Then
Set TableReturn = aTable
FindTable = True
End If
Next aTable
End Function
Function FindColNum(ByVal ColNm As String, _
ByRef Table As Table, _
ByRef ColReturn As Integer, _
Optional ByVal HeaderRow As Integer) As Boolean
'
' FindColNum Function
' This function steps through the columns of the specified table looking for a specific
' value in the second row (because the first row contains the table name), and then
' returns the column number of the column containing that value.
' Parameters:
' ColNm - The text string to look for in the first cell of each column; the column name.
' Table - The table containing the columns to check.
' ColReturn - A pointer to the column with the name ColNm.
' HeaderRow - The row number containing the headers to examine (if this isn't specified
' then the second row is searched).
' Return Values:
' True - returned if a coloumn with the name ColNm was found.
' False - returned if no column with the name ColNm was found.
'
Dim aCol As Column
Dim colCntr As Integer
Dim headerRowNum As Integer
FindColNum = False
If 0 = HeaderRow Then
headerRowNum = 2
Else
headerRowNum = HeaderRow
End If
' We check to ensure that the row we're about to check actually
' exists; i.e., that the table has enough rows in it
If headerRowNum <= Table.Rows.Count Then
For colCntr = 1 To Table.Columns.Count
If UCase(ColNm) = UCase(ReturnCellText(Table, headerRowNum, colCntr)) Then
ColReturn = colCntr
FindColNum = True
End If
Next colCntr
End If
End Function
Function FindRowNum(ByVal RowNm As String, _
ByRef Table As Table, _
ByRef RowReturn As Integer) As Boolean
'
' FindRowNum Function
' This function steps through the rows of the specified table looking for a specific
' value in the first column, and then returns the row number of the row containing
' that value.
' Parameters:
' RowNm - The text string to look for in the first cell of each row; the row name.
' Table - The table containing the rows to check.
' RowReturn - A pointer to the row with the name RowNm.
' Return Values:
' True - returned if a row with the name RowNm was found.
' False - returned if no row with the name RowNm was found.
'
Dim aRow As Row
Dim rowCntr As Integer
FindRowNum = False
' We start at the second row because the table name is in the first row.
For rowCntr = 2 To Table.Rows.Count
If UCase(RowNm) = UCase(ReturnCellText(Table, rowCntr, 1)) Then
RowReturn = rowCntr
FindRowNum = True
End If
Next rowCntr
End Function
Function ReturnCellText(ByRef Table As Table, _
ByVal Cell_Row As Integer, _
ByVal Cell_Col As Integer) As String
'
' ReturnCellText Function.
' Return unformatted text from a specific cell in a table.
'
Dim celTable As Cell
Dim rngTable As Range
Set celTable = Table.Cell(Cell_Row, Cell_Col)
Set rngTable = celTable.Range
rngTable.MoveEnd Unit:=wdCharacter, Count:=-1
ReturnCellText = rngTable.Text
End Function
Function ReturnCellFormattedText(ByRef Table As Table, _
ByVal Cell_Row As Integer, _
ByVal Cell_Col As Integer) As Range
'
' ReturnCellFormattedText Function
' Return the formatted text from a specific cell in a table.
'
Dim celTable As Cell
Dim rngTable As Range
Set celTable = Table.Cell(Cell_Row, Cell_Col)
Set rngTable = celTable.Range
rngTable.MoveEnd Unit:=wdCharacter, Count:=-1
Set ReturnCellFormattedText = rngTable.FormattedText.Duplicate
End Function
Sub SetCellText(ByRef Table As Table, _
ByVal Cell_Row As Integer, _
ByVal Cell_Col As Integer, _
ByVal Cell_Val As String)
'
' SetCellText Function.
' Write an unformatted text string into a specific cell in a table.
'
Dim celTable As Cell
Dim rngTable As Range
Set celTable = Table.Cell(Cell_Row, Cell_Col)
Set rngTable = celTable.Range
rngTable.MoveEnd Unit:=wdCharacter, Count:=-1
rngTable.Text = Cell_Val
End Sub
Note, the template and code are Copyright ©2005–2007 Christopher Rath. Permission is granted for any use of this template by others as long as this copyright statement is retained, other due and proper credit is provided to the author (e.g., don't claim you wrote this template or code), and the LGPL license is respected. This package is free software; you can redistribute it and/or modify it under the terms of version 2.1 of the GNU Lesser General Public License as published by the Free Software Foundation. See the LGPL licenese on the GNU.org website. This package is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE; on an “AS IS,” “WHERE IS” and “WITH ALL FAULTS” basis.