多工作簿Sheet1选项按钮选中内容复制到主工作簿的VBA实现方案

工作表里的选项按钮分两种类型，对应不同的处理逻辑，以下分别给出适配代码：

一、处理表单控件的选项按钮 #

表单控件的选项按钮属于Shape对象，需遍历工作表的Shapes集合判断选中状态：

Sub GetFormControlOptionValue()
    Dim masterWB As Workbook
    Dim targetWB As Workbook
    Dim targetWS As Worksheet
    Dim shp As Shape
    Dim targetRow As Integer ' 主工作簿写入数据的起始行
    
    ' 绑定主工作簿（假设当前运行代码的工作簿就是MasterWork）
    Set masterWB = ThisWorkbook
    targetRow = 2 ' 从第2行开始写入，可按需调整
    
    ' 遍历所有打开的工作簿
    For Each targetWB In Application.Workbooks
        ' 跳过主工作簿本身
        If targetWB.Name <> masterWB.Name Then
            Set targetWS = targetWB.Sheets("Sheet1")
            ' 遍历Sheet1中的表单控件选项按钮
            For Each shp In targetWS.Shapes
                If shp.Type = msoFormControl And shp.FormControlType = xlOptionButton Then
                    ' 判断是否被选中
                    If shp.ControlFormat.Value = xlOn Then
                        ' 将选中的Caption写入主工作簿A列，可修改目标区域
                        masterWB.Sheets("Sheet1").Cells(targetRow, "A").Value = shp.TextFrame2.TextRange.Text
                        targetRow = targetRow + 1
                        Exit For ' 一组选项按钮仅一个选中，找到即退出循环
                    End If
                End If
            Next shp
        End If
    Next targetWB
End Sub

二、处理ActiveX控件的选项按钮 #

ActiveX控件的选项按钮属于OLEObject对象，需遍历工作表的OLEObjects集合：

Sub GetActiveXOptionValue()
    Dim masterWB As Workbook
    Dim targetWB As Workbook
    Dim targetWS As Worksheet
    Dim oleObj As OLEObject
    Dim targetRow As Integer
    
    Set masterWB = ThisWorkbook
    targetRow = 2
    
    For Each targetWB In Application.Workbooks
        If targetWB.Name <> masterWB.Name Then
            Set targetWS = targetWB.Sheets("Sheet1")
            ' 遍历Sheet1中的ActiveX选项按钮
            For Each oleObj In targetWS.OLEObjects
                If TypeName(oleObj.Object) = "OptionButton" Then
                    If oleObj.Object.Value = True Then
                        masterWB.Sheets("Sheet1").Cells(targetRow, "A").Value = oleObj.Object.Caption
                        targetRow = targetRow + 1
                        Exit For
                    End If
                End If
            Next oleObj
        End If
    Next targetWB
End Sub

实用提示 #

• 若需处理未打开的指定路径工作簿，可添加Workbooks.Open代码打开文件，处理后记得关闭，配合Application.ScreenUpdating = False可提升运行效率
• 主工作簿的目标单元格区域可根据需求修改Cells(targetRow, "A")的列标识和起始行
• 提前确认所有目标工作簿的Sheet1中存在对应类型的选项按钮，避免运行时错误

内容的提问来源于stack exchange，提问作者Learner77