OB Auswerten
20.01.2009 15:51:00
adrian
habe folgendes Dilemma wo ich noch nicht wirklich weiß wie ich ran gehen soll =/
Wäre super wenn mir da jmd. helfen kann! =)
erstelle "OptionsButtons" wie folgt:
Für jeden Namen in einer ComboBox aufgelistet kann man diese 3 untereinander angeordneten OB erstellen.
Ich habe mehrere von diesen Sheets in denen man diese OB erstellen kann!
In einem Hauptsheet ("Overview") werden alle Namen, die in allen ComboBoxen zusammen auftreten, in einen Bereich gespeichert und somit aufgelistet!
Wenn nun bei den OB der Wert "No!" angeklickt ist möchte ich die Namen im Hauptsheet z.B. rot einfärben!
Für "Yes" = grün und für "Possible" = Orange.
Hat hier ein genialer VBA Profi vll. eine Idee bzw. Vorschläge wie ich das machen kann?
Wäre echt super happy!!
lg
adrian
Modulsyntax:
Sub FirstAddOptionButton(Position2 As Range)
Application.ScreenUpdating = False
For OBCount = 1 To 3
With ActiveSheet
Set Objekt = .OLEObjects.Add(ClassType:="Forms.OptionButton.1", Left:=Position2.Left, _
Width:=Position2.Width, Top:=Position2.Top, Height:=Position2.Height)
Set OB = Objekt.Object
With OB
.Name = "FC" & ActiveSheet.ComboBox1.Value & "OptionButton" & OBCount
.GroupName = "FC" & ActiveSheet.ComboBox1.Value
.BackColor = &H80000005
.Font = "Georgia"
.Font.Size = 16
.Font.Bold = True
.Height = 26
If OBCount = 1 Then .Caption = "Yes!": .ForeColor = "&HC000": .Width = 63
If OBCount = 2 Then .Caption = "Possible!": .ForeColor = "&H80FF": .Width = 93
If OBCount = 3 Then .Caption = "No!": .ForeColor = "&HFF": .Width = 49
End With
With .Shapes(Objekt.Name)
.Placement = 1
End With
Set Position2 = Position2.Offset(2, 0)
End With
Next OBCount
Application.ScreenUpdating = True
End Sub
Syntax im Sheet:
Sub CommandButton5_Click()
If ComboBox1.Value "" Then
For Each Objekt In ActiveSheet.OLEObjects
If InStr(Objekt.Name, "FC" & ComboBox1.Value) Then
MsgBox "A Field with OptionButtons for this ODM already exists!" & vbNewLine & vbNewLine & _
"Please add a new ODM at first!"
Exit Sub
End If
Next
FirstAddTextfeld Range("K20")
FirstAddOptionButton Range("S25")
Else
MsgBox "Please choose ODM in Dropdown-Box!"
End If
End Sub
ComboBox wird folgend mit Werten aus Bereichen gefüllt:
Private Sub Worksheet_Activate()
With Me.ComboBox1
.Clear
For Each Cell In Range("SupplierUS")
.AddItem Cell.Value
Next
End With
With Me.ComboBox2
.Clear
For Each Cell In Range("SupplierUS")
.AddItem Cell.Value
Next
End With
End Sub
Anzeige