Neue Arbeitsmappen mit Optionsfeldern erstellen

Thema: Allgemein - Gruppe Arbeitsmappe

Arbeitsmappe

244804    093200

Problem: Es sollen 3 neue Arbeitsmappen mit jeweils 3 Optionsfeldern zur Zell-Farbfestlegung erstellt werden.

StandardModule: Modul1

Sub NewWkbWithBtns()
   Dim oOption As OptionButton
   Dim oVbc As Object
   Dim iWkb As Integer, iOption As Integer, iLeft As Integer
   Dim sCode As String
   Application.VBE.MainWindow.Visible = False
   Application.ScreenUpdating = False
   sCode = "Sub Farbfestlegung()" & vbLf
   'sCode = sCode & "   Selection Case Activesheet.OptionButtons(Application.Caller).Caption" & vbLf
   'sCode = sCode & "      Case ""rot"": range(""A1"").Interior.Colorindex = vbRed" & vbLf
   sCode = sCode & "   Dim col as New Collection" & vbLf
   sCode = sCode & "   Dim sCaller as String" & vbLf
   sCode = sCode & "   sCaller = Activesheet.OptionButtons(Application.Caller).Caption" & vbLf
   sCode = sCode & "   col.Add ""3"", ""rot""" & vbLf
   sCode = sCode & "   col.Add ""6"", ""gelb""" & vbLf
   sCode = sCode & "   col.Add ""4"", ""grün""" & vbLf
   sCode = sCode & "   Range(""A1"").Interior.Colorindex = col(sCaller)" & vbLf
   sCode = sCode & "End Sub" & vbLf
   For iWkb = 1 To 3
      Workbooks.Add 1
      Rows(1).RowHeight = 50
      Columns(1).ColumnWidth = 50
      iLeft = 0
      For iOption = 1 To 3
         Set oOption = ActiveSheet.OptionButtons.Add(iLeft, 0, 60, 15)
         With oOption
            Select Case iOption
               Case 1: .Caption = "rot"
               Case 2: .Caption = "gelb"
               Case 3: .Caption = "grün"
            End Select
            .OnAction = ActiveWorkbook.Name & "!Farbfestlegung"
         End With
         iLeft = iLeft + 65
      Next iOption
      Set oVbc = ActiveWorkbook.VBProject.VBComponents.Add(1)
      oVbc.CodeModule.AddFromString sCode
   Next iWkb
   Application.ScreenUpdating = True
End Sub