Showing posts with label Word. Show all posts
Showing posts with label Word. Show all posts

Tuesday, November 6, 2012

How to populate a Content Control Combo Box with multiple items in a Word 2010 document via a Macro

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.

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.