Option Button Szenario

[snb]

In diesen Fall wäre die Verwendung einer Userform die geeignete Vorgehensweise.

Lade mal bitte eine Beispieldatei hoch.

[Glorifier]

Hi schauan,

habe die Zellbezüge ins sub eingefügt, stehe aber anscheinend auf dem Schlauch, da ich einen Compile Error bekomme. Habe mal eine Beispieldatei angehängt. Ich denke, so geht es besser.

Wo liegt mein Fehler?  

Danke und VG

[schauan]

Hallöchen,

Du hast im Modul2 unter dem ersten
Sub LosGehts()
…
End Sub

nur

Sub SetupSurvey(FirstOptBtnCell As Range, NumberOfQuestions As Long)


Da steht keinerlei Code resp. auch kein End Sub dazu.

Korrekt wäre, mit Ausommentierung (Oder Löschung) der beiden Dim für die nun übergebenen Variablen

Code:

Sub SetupSurvey(FirstOptBtnCell As Range, NumberOfQuestions As Long)
Dim grpBox As GroupBox
Dim optBtn As OptionButton
Dim maxBtns As Long
Dim myCell As Range
Dim myRange As Range
Dim wks As Worksheet
Dim iCtr As Long
'Dim FirstOptBtnCell As Range
'Dim NumberOfQuestions As Long

maxBtns = 10
NumberOfQuestions = 2

Set wks = ActiveSheet
With wks
  Set FirstOptBtnCell = .Range("F5")

  Set myRange = FirstOptBtnCell _
    .Resize(NumberOfQuestions, 1)
    
  myRange.Offset(0, -3).Value = 1

  myRange.EntireRow.RowHeight = 38
  myRange.Resize(, maxBtns) _
    .EntireColumn.ColumnWidth = 9.5

  'clean up existing junk
  .GroupBoxes.Delete
  .OptionButtons.Delete

End With

For Each myCell In myRange
  With myCell.Resize(1, maxBtns)
    Set grpBox = wks.GroupBoxes.Add _
        (Top:=.Top, Left:=.Left, _
          Height:=.Height, _
          Width:=.Width)
    With grpBox
      .Caption = ""
      .Visible = True 'False
    End With
  End With
  For iCtr = 0 To maxBtns - 1
    With myCell.Offset(0, iCtr)
      Set optBtn = wks.OptionButtons.Add _
        (Top:=.Top, Left:=.Left, _
        Height:=.Height, Width:=.Width)
      optBtn.Caption = ""
      If iCtr = 0 Then
        With myCell.Offset(0, -1)
          optBtn.LinkedCell _
            = .Address(external:=True)
        End With
      End If
    End With
  Next iCtr
Next myCell
End Sub

[schauan]

Hallöchen,

hier mal die beiden Codes komplett und getestet mit noch ein paar kleinen Änderungen.

Code:

Sub LosGehts()
Dim FirstOptBtnCell As Range
Dim NumberOfQuestions As Long
Set wks = ActiveSheet
With wks
  'clean up existing junk
  .GroupBoxes.Delete
  .OptionButtons.Delete
  Set FirstOptBtnCell = .Range("F5")
  NumberOfQuestions = 3
  'Aktion aufrufen
  Call SetupSurvey(FirstOptBtnCell, NumberOfQuestions)
  'naechste Reihe
  Set FirstOptBtnCell = .Range("F9")
  NumberOfQuestions = 6
  'Aktion aufrufen
  Call SetupSurvey(FirstOptBtnCell, NumberOfQuestions)
  'naechste Reihe
  Set FirstOptBtnCell = .Range("F16")
  NumberOfQuestions = 14
  'Aktion aufrufen
  Call SetupSurvey(FirstOptBtnCell, NumberOfQuestions)
  'naechste Reihe
  Set FirstOptBtnCell = .Range("F31")
  NumberOfQuestions = 5
  'Aktion aufrufen
  Call SetupSurvey(FirstOptBtnCell, NumberOfQuestions)
  'naechste Reihe
  Set FirstOptBtnCell = .Range("F37")
  NumberOfQuestions = 9
  'Aktion aufrufen
  Call SetupSurvey(FirstOptBtnCell, NumberOfQuestions)
End With

End Sub

Sub SetupSurvey(FirstOptBtnCell As Range, NumberOfQuestions As Long)
Dim grpBox As GroupBox
Dim optBtn As OptionButton
Dim maxBtns As Long
Dim myCell As Range
Dim myRange As Range
Dim wks As Worksheet
Dim iCtr As Long
'Dim FirstOptBtnCell As Range
'Dim NumberOfQuestions As Long
maxBtns = 10
Set wks = ActiveSheet
With wks
  Set myRange = FirstOptBtnCell _
    .Resize(NumberOfQuestions, 1)
  myRange.Offset(0, -3).Value = 1
  myRange.EntireRow.RowHeight = 38
  myRange.Resize(, maxBtns) _
    .EntireColumn.ColumnWidth = 9.5
  For Each myCell In myRange
    With myCell.Resize(1, maxBtns)
      Set grpBox = wks.GroupBoxes.Add _
          (Top:=.Top, Left:=.Left, _
            Height:=.Height, _
            Width:=.Width)
      With grpBox
        .Caption = ""
        .Visible = True 'False
      End With
    End With
    For iCtr = 0 To maxBtns - 1
      With myCell.Offset(0, iCtr)
        Set optBtn = wks.OptionButtons.Add _
          (Top:=.Top, Left:=.Left, _
          Height:=.Height, Width:=.Width)
        optBtn.Caption = ""
        If iCtr = 0 Then
          With myCell.Offset(0, -1)
            optBtn.LinkedCell _
              = .Address(external:=True)
          End With
        End If
      End With
    Next iCtr
  Next myCell
End With
End Sub

[Glorifier]

@schauan: Perfekt, ich benenne mein Erstgeborenes nach Dir!