Solved: Get MS Word OptionButton value from Excel VBA

[spalmgren]

In 2007 it looks like this when I add an ActiveX Option button.
[VBA]Sub AddButton()
'
' AddButton Macro
'
'
ActiveDocument.ToggleFormsDesign
Selection.InlineShapes.AddOLEControl ClassType:="Forms.OptionButton.1"
End Sub[/VBA]

[Kenneth Hobs]

It appears to be the same. At this point, you might post a sample DOCX. I would have to convert it to a DOC to test. I don't expect to find a problem though.

[spalmgren]

Here is a sample .doc file.

[Kenneth Hobs]

In Excel 2003, I got:
OptionButton2 FALSE

OptionButton21 FALSE

OptionButton22 FALSE

OptionButton1 FALSE

OptionButton11 FALSE

OptionButton12 TRUE

OptionButton13 FALSE

OptionButton14 FALSE

OptionButton16 FALSE

OptionButton17 FALSE

[spalmgren]

Yeah, when I run it from a .xls of file (instead .xlsx) it works!

Thanks a lot Kenneth! You've saved me a lot of trouble!

Just a short follow-up question; is there an easy way to adapt the script to include all controls, not only option buttons (but also check boxes and text boxes)?

[Kenneth Hobs]

Yes, leave out the IF and End If lines in the For loop.

In the debug commented line, notice how one can check for a control type in another way. One could write the code to just iterate certain types of controls with IF's or a Select Case.
[vba]Sub MSWordOptionButtionInfo()
'Requires reference: MSWord 11.0 Object Library
Dim oShape As Word.InlineShape
Dim wdApp As Object, wd As Object, rn As Long
Dim wordFilename As String, startColumnName As String
Dim r As Range, counter As Integer

'Inputs
'wordFilename = "x:\MSWord\OptionButtons.doc"
wordFilename = "x:\MSWord\a.doc"
startColumnName = "A"

'Exit if word file does not exist
If Dir(wordFilename) = "" Then Exit Sub

'set wdApp reference
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0

'Set DOC file with option buttons to open
Set wd = wdApp.Documents.Open(wordFilename)
wdApp.Visible = False

'Set Initial Range and counter
Set r = Range(startColumnName & Rows.Count).End(xlUp).Offset(1, 0)
counter = 0

'Put option button name at in of startColumnName and value in cell to the right
For Each oShape In wdApp.ActiveDocument.InlineShapes
'Debug.Print oShape.OLEFormat.ClassType 'Forms.OptionButton.1
'If oShape.OLEFormat.progID = "Forms.OptionButton.1" Then
'Debug.Print Split(oShape.OLEFormat.ClassType, ".")(1) 'OptionButton
If Split(oShape.OLEFormat.ClassType, ".")(1) = "OptionButton" Then
r.Offset(counter, 0).Value = oShape.OLEFormat.Object.Name
r.Offset(counter, 1).Value = oShape.OLEFormat.Object.Value
counter = counter + 1
End If
Next oShape

Set wd = Nothing
Set wdApp = Nothing
End Sub[/vba]

[Bob Phillips]

Yeah, when I run it from a .xls of file (instead .xlsx) it works!

Thanks a lot Kenneth! You've saved me a lot of trouble!

Just a short follow-up question; is there an easy way to adapt the script to include all controls, not only option buttons (but also check boxes and text boxes)?

Worked fine from an xlsx for me