I am building a data entry form using a word document. The logic of why this is a good choice is not relevant. My problem was that I needed to add a set of combo boxes in table cells, each loaded with a list of option for the user to pick from.
There is the option to hand enter each list item... but as I had about 100 items and a dozen duplicate combo boxes... this would have been painful. The fact that I would need to update this list in the future just made it torture. So... is there a faster way?
After some googling without any success, I came up with a very quick and dirty method.
My over view is:
I have the list of items I want in the combo box in a text file in the same directory as the word document. (Note that each item must be Unique as the combo boxes do not like duplicates)
I have built the word document with the Content Control Combo boxes in the correct locations and saved it to the same directory as the text file.
I then added a new module to the word doc via the VBA Editor in Word and wrote this simple little macro.
Option Explicit
Sub PopulateCareProviderComboBoxes()
Dim itemFromFile As String
Dim cc As ContentControl
For Each cc In ActiveDocument.ContentControls
If cc.Type = wdContentControlComboBox Then 'checks if the control is a combo box
cc.DropdownListEntries.Clear 'get rid of any existing entries in the combo box
Open "CareProviderDumpList.txt" For Input As #1 'this is my text file with the items I want to add
Do While Not EOF(1)
Input #1, itemFromFile
cc.DropdownListEntries.Add itemFromFile 'put the item from the text file into the combo box
Loop
Close #1
End If
Next
End Sub
I only needed to check if the control is a combo box, as all the combo boxes on my form are the same. You may need to identify a specific combo box. You can do this by testing the Title property on the Content Control object.
E.g:
If cc.Title = "Customers" then ....
Once thats done, I simply ran the macro to load the list from the text file to each of the combo boxes. Then saved the word doc with the new items in place.
Job done.
Showing posts with label Word. Show all posts
Showing posts with label Word. Show all posts
Tuesday, November 6, 2012
Monday, April 26, 2010
Archive from 7_9_07 - Word Macro to extract a Unique list of words from a document
This MS Word macro strips all words from a document and creates a list of unique words in a new document. It dumps any word starting with a non-ascii character or that is less than 2 characters long.
Its based on some code from:
http://www.microsoft.com/technet/scriptcenter/resources/qanda/jun06/hey0628.mspx
Public Sub MakeUniqueList()
'This will make a list of all unique words in the document
' and stash them in a new document
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objDoc = Application.ActiveDocument
Set colWords = objDoc.Words
Dim cleanWord As String
For Each strWord In colWords
'clean up the word
strWord = Trim(LCase(strWord))
cleanWord = strWord
'see if we want to add it to the dic
If KeepWord(cleanWord) Then
If objDictionary.Exists(cleanWord) Then
Else
objDictionary.Add strWord, strWord
End If
End If
Next
'create a new document to hold the list
Set objDoc2 = Application.Documents.Add()
Set objSelection = Application.Selection
For Each strItem In objDictionary.Items
objSelection.TypeText strItem & vbCrLf
Next
Set objRange = objDoc2.Range
objRange.Sort
End Sub
Private Function KeepWord(ByRef word As String) As Boolean
'function to try to remove some of the rubbish words from the list
'get rid of short words
If (Len(word) < 2) Then
'retVal = False
KeepWord = False
Exit Function
End If
'check for punctuation characters
'ASC function (65-90 is ucase ) 97 - 122 is lcase
If (Asc(word) < 65) Or (Asc(word) > 122) Or ((Asc(word) > 90) And (Asc(word) < 97)) Then
KeepWord = False
Exit Function
End If
KeepWord = True
End Function
Used in Microsoft Word 2003.
Its based on some code from:
http://www.microsoft.com/technet/scriptcenter/resources/qanda/jun06/hey0628.mspx
Public Sub MakeUniqueList()
'This will make a list of all unique words in the document
' and stash them in a new document
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objDoc = Application.ActiveDocument
Set colWords = objDoc.Words
Dim cleanWord As String
For Each strWord In colWords
'clean up the word
strWord = Trim(LCase(strWord))
cleanWord = strWord
'see if we want to add it to the dic
If KeepWord(cleanWord) Then
If objDictionary.Exists(cleanWord) Then
Else
objDictionary.Add strWord, strWord
End If
End If
Next
'create a new document to hold the list
Set objDoc2 = Application.Documents.Add()
Set objSelection = Application.Selection
For Each strItem In objDictionary.Items
objSelection.TypeText strItem & vbCrLf
Next
Set objRange = objDoc2.Range
objRange.Sort
End Sub
Private Function KeepWord(ByRef word As String) As Boolean
'function to try to remove some of the rubbish words from the list
'get rid of short words
If (Len(word) < 2) Then
'retVal = False
KeepWord = False
Exit Function
End If
'check for punctuation characters
'ASC function (65-90 is ucase ) 97 - 122 is lcase
If (Asc(word) < 65) Or (Asc(word) > 122) Or ((Asc(word) > 90) And (Asc(word) < 97)) Then
KeepWord = False
Exit Function
End If
KeepWord = True
End Function
Used in Microsoft Word 2003.
Labels:
Macro,
Programming,
Word
Subscribe to:
Posts (Atom)