Clever-Excel-Forum

Seiten: 1 2

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

Lade mal bitte eine Beispieldatei hoch.

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? Huh

Danke und VG

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

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

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

Seiten: 1 2

snb

Glorifier

schauan

schauan

Glorifier