Combobox Auswahl

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub ComboBox1_DropButtonClick() If Range("A1") = 1 Then ComboBox1.Clear For i = 4 To 20 With Worksheets("AlleTage") ComboBox1.AddItem .Cells(i, "I") & "," & .Cells(i, "J") End With Next i End If End Sub

Private Sub aaComboBox1_DropButtonClick() If Range("A1") = 1 Then ActiveSheet.ComboBox1.ListFillRange = "Feiertage!I4:I23" ' ActiveSheet.ComboBox1.ListIndex = -1 ActiveSheet.Unprotect (getStrPasswort) ActiveSheet.Range("D5") = ActiveSheet.ComboBox1 ActiveSheet.Protect (getStrPasswort) ElseIf Range("A1") = 2 Then ActiveSheet.ComboBox1.ListFillRange = "Feiertage!M4:M23" ActiveSheet.Unprotect (getStrPasswort) ActiveSheet.Range("D5") = ActiveSheet.ComboBox1 ActiveSheet.Protect (getStrPasswort) Else ActiveSheet.ComboBox1.ListFillRange = "" End If End Sub

Private Sub ComboBox1_DropButtonClick() If Range("A1") = 1 Then ComboBox1.Clear ComboBox1.ListfillRange="" For i = 4 To 20 With Worksheets("AlleTage") ComboBox1.AddItem .Cells(i, "I") & "," & .Cells(i, "J") End With Next i End If End Sub

Option Explicit Sub ComboBox1_DropButtonClick() Dim i% If Range("A1") = 1 Then ComboBox1.Clear ComboBox1.RowSource = "" For i = 4 To 20 With Worksheets("Tabelle1") ComboBox1.AddItem .Cells(i, "I") & "," & .Cells(i, "J") End With Next i End If End Sub

Private Sub ComboBox1_DropButtonClick() Dim i% If Range("A1") = 1 Then With ComboBox1 .ListFillRange = "" .Clear End With With Worksheets("Feiertage") For i = 4 To 20 ComboBox1.AddItem .Cells(i, 9).Text & ", " & .Cells(i, 10).Text Next i End With End If If Range("A1") = 2 Then With ComboBox1 .ListFillRange = "" .Clear End With With Worksheets("Feiertage") For i = 4 To 20 ComboBox1.AddItem .Cells(i, 12).Text & ", " & .Cells(i, 14).Text Next i End With End If End Sub

Private Sub xxWorksheet_Change(ByVal Target As Range) Dim RaZelle As Range On Error GoTo errhandler If Not Intersect(Range("D14:D44"), Target) Is Nothing Then Application.EnableEvents = False For Each RaZelle In Target Select Case UCase(RaZelle) Case "F", "U", "UU", "K" RaZelle = UCase(RaZelle) RaZelle.Offset(, 1).Resize(, 3).ClearContents Case Else End Select Next RaZelle Application.EnableEvents = True End If errhandler: Application.EnableEvents = True End Sub

Hallo Walter,
so Ok?

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lngRow As Long
    Dim objRange As Range, objCell As Range

    If Target.Address = "$A$1" Then
        Call ComboBox1.Clear
        Select Case Target.Value
            Case 1
                With Worksheets("Feiertage")
                    For lngRow = 4 To 20
                        ComboBox1.AddItem .Cells(lngRow, 9).Text & ", " & .Cells(lngRow, 10).Text
                    Next lngRow
                End With
            Case 2
                With Worksheets("Feiertage")
                    For lngRow = 4 To 20
                        ComboBox1.AddItem .Cells(lngRow, 12).Text & ", " & .Cells(lngRow, 14).Text
                    Next lngRow
                End With
        End Select
    Else
        Set objRange = Intersect(Range("D14:D44"), Target)
        If Not objRange Is Nothing Then
            Application.EnableEvents = False
            For Each objCell In objRange
                Select Case UCase$(objCell.Text)
                    Case "F", "U", "UU", "K"
                        objCell.Value = UCase$(objCell.Text)
                        Call objCell.Offset(0, 1).Resize(1, 3).ClearContents
                End Select
            Next objCell
            Set objRange = Nothing
            Application.EnableEvents = True
        End If
    End If
End Sub

Gruß
Nepumuk

Hallo Walter,
komisch, normalerweise speichern ActiveX-Controls auf Tabellenblättern ihre Werte. Aber bei mir verliert die ComboBox auch ihre Werte. Dann so:
Im Modul "DieseArbeitsmappe":

Option Explicit

Private Sub Workbook_Open()
Call Worksheets("Tabelle1").FillComboBox
End Sub

Im Modul der Tabelle:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim objRange As Range, objCell As Range
    If Target.Address = "$A$1" Then
        Call FillComboBox
    Else
        Set objRange = Intersect(Range("D14:D44"), Target)
        If Not objRange Is Nothing Then
            Application.EnableEvents = False
            For Each objCell In objRange
                Select Case UCase$(objCell.Text)
                    Case "F", "U", "UU", "K"
                        objCell.Value = UCase$(objCell.Text)
                        Call objCell.Offset(0, 1).Resize(1, 3).ClearContents
                End Select
            Next objCell
            Set objRange = Nothing
            Application.EnableEvents = True
        End If
    End If
End Sub

Public Sub FillComboBox()
    Dim lngRow As Long
    Call ComboBox1.Clear
    Select Case Cells(1, 1).Value
        Case 1
            With Worksheets("Feiertage")
                For lngRow = 4 To 20
                    ComboBox1.AddItem .Cells(lngRow, 9).Text & ", " & .Cells(lngRow, 10).Text
                Next lngRow
            End With
        Case 2
            With Worksheets("Feiertage")
                For lngRow = 4 To 20
                    ComboBox1.AddItem .Cells(lngRow, 12).Text & ", " & .Cells(lngRow, 14).Text
                Next lngRow
            End With
    End Select
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

39
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Combobox Auswahl

39 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

39
Beiträge zum Forumthread

Beiträge zu diesem Forumthread