批量插入选择框

Sub fill_range_with_optionbuttons()
'Erik Van Geit
'050520 0138
Dim rownr As Long, i As Integer
Dim counter As Long
Dim rng As Range
Dim txt(2) As String
Dim nm(2) As String

'replace each occurence of 22 by 800
Set rng = Range("A1:B22")
txt(1) = "R"
txt(2) = "V"
nm(1) = "RRR"   'single R or V impossible "R1" is invalid name (= cellreference)
nm(2) = "VVV"
Application.ScreenUpdating = False

Rows("1:22").RowHeight = 18

    For rownr = 1 To 22
    counter = 0
        For i = 1 To 2
        counter = counter + 1
          Set rng = Cells(rownr, i)
              If i = 1 Then
              ActiveSheet.GroupBoxes.Add(rng.Left, rng.Top, rng.Width * 2, rng.Height).Name = "box" & rownr
              ActiveSheet.Shapes("box" & rownr).OLEFormat.Object.Characters.Text = ""
              End If
          ActiveSheet.OptionButtons.Add(rng.Left, rng.Top, rng.Width, rng.Height).Name = nm(i) & rownr
              With ActiveSheet.Shapes(nm(i) & rownr).OLEFormat.Object
              .Characters.Text = txt(i)
              .LinkedCell = Cells(rownr, 3).Address
              End With
        Next i
    Next rownr

Application.ScreenUpdating = False

End Sub