How to add option buttons to group in Excel 2010 sheet using VBA?

问题

I want to add many option button to an excel worksheet (not to a VBA-form) and want to group them by row. The result should look something like this:

Here is the code I'm using so far:

    For d = 1 To 31
            Set checkboxKrankCell = Range("H" + Trim(Str(d)))
            Set checkboxUrlaubCell = Range("I" + Trim(Str(d)))
            Set checkboxJazCell = Range("J" + Trim(Str(d)))
            groupWidth = checkboxKrankCell.Width + checkboxUrlaubCell.Width + checkboxJazCell.Width
            Set groupBoxOptionButtons = ActiveSheet.GroupBoxes.Add(checkboxKrankCell.Left - 1, checkboxKrankCell.Top - 2, groupWidth + 1, checkboxKrankCell.Height)
            With groupBoxOptionButtons
                .Name = "GroupBox_" + Trim(Str(d))
                .Caption = ""
            End With
            Set checkboxKrank = ActiveSheet.OptionButtons.Add(checkboxKrankCell.Left, checkboxKrankCell.Top - 1, checkboxKrankCell.Width, checkboxKrankCell.Height)
            With checkboxKrank
              .Caption = ""
            End With
  #1          checkboxKrank.GroupBox = groupBoxOptionButtons
            Set checkboxUrlaub = ActiveSheet.OptionButtons.Add(checkboxUrlaubCell.Left, checkboxUrlaubCell.Top - 1, checkboxUrlaubCell.Width, checkboxUrlaubCell.Height)
            With checkboxUrlaub
              .Caption = ""
            End With
            Set checkboxJaz = ActiveSheet.OptionButtons.Add(checkboxJazCell.Left, checkboxJazCell.Top - 1, checkboxJazCell.Width, checkboxJazCell.Height)
            With checkboxJaz
              .Caption = ""
 #2           .GroupBox = groupBoxOptionButtons
            End With
        Next d

I would expect to assign the option buttons to the group for the current row by setting the GroupBox property (see #1 or #2). But both methods just gave me an error saying

'The object does not support the property or methode'.

Any help or hint is welcome ;-)

Based on the tip from snb I have modified my function like this:

Sub AddOptionButtons()
    ActiveSheet.OptionButtons.Delete
    For d = 1 To 31
        Set checkboxKrankCell = Range("H" + Trim(Str(d + 4)))
        Set checkboxUrlaubCell = Range("I" + Trim(Str(d + 4)))
        Set checkboxJazCell = Range("J" + Trim(Str(d + 4)))
        option1Name = "Krank_" + Trim(Str(d))
        option2Name = "Urlaub_" + Trim(Str(d))
        option3Name = "Jaz_" + Trim(Str(d))
        Set checkboxKrank = ActiveSheet.OptionButtons.Add(checkboxKrankCell.Left, checkboxKrankCell.Top - 1, checkboxKrankCell.Width, checkboxKrankCell.Height)
        With checkboxKrank
          .Caption = ""
          .Name = option1Name
        End With
        Set checkboxUrlaub = ActiveSheet.OptionButtons.Add(checkboxUrlaubCell.Left, checkboxUrlaubCell.Top - 1, checkboxUrlaubCell.Width, checkboxUrlaubCell.Height)
        With checkboxUrlaub
          .Caption = ""
          .Name = option2Name
        End With
        Set checkboxJaz = ActiveSheet.OptionButtons.Add(checkboxJazCell.Left, checkboxJazCell.Top - 1, checkboxJazCell.Width, checkboxJazCell.Height)
        With checkboxJaz
          .Caption = ""
          .Name = option3Name
        End With
        ActiveSheet.Shapes.Range(Array(option1Name, option2Name, option3Name)).Group
    Next d
End Sub

I don't get any errors using Shapes.Range(...).Group. But still all option buttons from on the sheet are all mutual exclusive.
Seems grouping does not work here.

回答1:

Try the following code on an empty workbook. It will give you an option to choose only ONE optionbutton on each row, which is what you want, as far as I understood (I also created a linked cell reference, just in case you would like to take further action, given the choice of a user.):

Sub AddOptionButtons()
    Dim btn1 As OptionButton
    Dim btn2 As OptionButton
    Dim btn3 As OptionButton
    Dim grbox As GroupBox
    Dim t As Range
    Dim s As Range
    Dim p As Range
    Dim i As Integer

    ActiveSheet.OptionButtons.Delete
    ActiveSheet.GroupBoxes.Delete
    For i = 5 To 35 Step 1
        Set t = ActiveSheet.Range(Cells(i, 8), Cells(i, 8))
        Set s = ActiveSheet.Range(Cells(i, 9), Cells(i, 9))
        Set p = ActiveSheet.Range(Cells(i, 10), Cells(i, 10))
        Set btn1 = ActiveSheet.OptionButtons.Add(t.Left, t.Top, t.Width, t.Height)
        Set btn2 = ActiveSheet.OptionButtons.Add(s.Left, s.Top, s.Width, s.Height)
        Set btn3 = ActiveSheet.OptionButtons.Add(p.Left, p.Top, p.Width, p.Height)
        Set grbox = ActiveSheet.GroupBoxes.Add(t.Left, t.Top, t.Width + 100, t.Height)
        With btn1
          .Caption = ""
          .Display3DShading = True
          .LinkedCell = "M" & i
        End With

        With btn2
          .Caption = ""
          .Display3DShading = True
        End With

        With btn3
          .Caption = ""
          .Display3DShading = True
        End With

        With grbox
          .Caption = ""
          .Visible = False
        End With
    Next i
End Sub

回答2:

I'd use:

Sub M_snb()
  ReDim sn(2)

  For j = 1 To 2
   For jj = 1 To 3
    With Sheet1.OptionButtons.Add(Cells(j, jj).Left, Cells(j, jj).Top - 1, Cells(j, jj).Width, Cells(j, jj).Height)
     sn(jj - 1) = .Name
    End With
   Next
   Sheet1.Shapes.Range(sn).Group
  Next
End Sub

来源：https://stackoverflow.com/questions/30545772/how-to-add-option-buttons-to-group-in-excel-2010-sheet-using-vba

标签

excel

vba

excel-vba

excel-2010