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]
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]
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.
Here is a sample .doc file.
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
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)?
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]
Worked fine from an xlsx for meOriginally Posted by spalmgren
![]()
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber