Zwei ursprüngliche Rechtsklickereignisse handhaben

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Zwei ursprüngliche Rechtsklickereignisse handhaben
von: Torsten
Geschrieben am: 25.05.2015 13:48:40

Hallo zusammen,
im Tabellenblatt1 liegt bereits folgendes Ereignis:
################

Public Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
If Target.Row > 9 And Target.Row < 30 And Target.Column > 11 And Target.Column < 377 Then
Wahl_Uebergeben Target
End If
End Sub

################
nun möchte ich folgendes Ereignis welches für das selbe Tabellenblatt gilt einbiden.
Dieses Ereignis jedoch, würde ich nicht per Rechtsklick, sondern über CommandButton1_Click aus einer Userform starten.
Beide zusammen beißen sich logischerweise, weil sie beim Rechtsklick loslegen wollen.
################
Public Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
    Dim Spa1&, Spa2&, Zei_Abwesend&, Zei_Vertretung&, Abt_Abwesend, Name_Abw As String,  _
Schicht_Abw
    Dim dat_1, dat_2
    Dim Zei_List&, Zei_L&, Spa_L&
    Dim arrListbox()
    
    'Die folgenden Konstanten müssen ggf. angpasst werden, wenn der Aufbau des Tabellenblattes  _
geändert wird
    Const Spa_Farbe = 1     'Spalte mit farbigeb Zellen zu den Namen
    Const Spa_Schicht& = 2  'Spalte C - Spalte mit Abteilung
    Const Spa_Abt& = 4      'Spalte D - Spalte mit Abteilungen
    Const Spa_Name& = 6     'Spalte E - Spalte mit Namen
    Const Spa_Datum1& = 12   'Spalte F - 1. Spalte mit einem Kalender-Datum
    
    Const Zei_Name1& = 10    ' 1. Zeile mit einem Namen
    Const Zei_Datum& = 9    'Zeile mit Datumswerten
    
    With Target
        Zei_L = Cells(Rows.Count, Spa_Name).End(xlUp).Row
        Spa_L = Cells(Zei_Datum, Columns.Count).End(xlToLeft).Column
        'Prüfung, ob nur Zellen in einer Zeile markiert wurden und 1. Zelle des Bereichs Inhalt  _
hat.
        If .Rows.Count = 1 And Target.Cells(1, 1) <> "" Then
            Select Case .Column
                Case Spa_Datum1 To Spa_L
                    Select Case .Row
                        Case Zei_Name1 To Zei_L
                            Cancel = True
                            
                            Spa1 = .Column
                            Spa2 = Spa1 + .Columns.Count - 1
                            Zei_Abwesend = .Row
                            Abt_Abwesend = Me.Cells(Zei_Abwesend, Spa_Abt).value
                            Name_Abw = Me.Cells(Zei_Abwesend, Spa_Name).text
                            Schicht_Abw = Me.Cells(Zei_Abwesend, Spa_Schicht).value
                            dat_1 = Me.Cells(Zei_Datum, Spa1).value
                            dat_2 = Me.Cells(Zei_Datum, Spa2).value
                            
                            ReDim arrListbox(Zei_Name1 To Zei_L, 1 To 4)
                            Zei_List = LBound(arrListbox, 1)
                            'im Zeitraum verfügbare Vertreter in Auswahlliste aufnehmen
                            For Zei_Vertretung = Zei_Name1 To Zei_L
                                'Prüfen, ob Vertreter im Zeitraum verfühbar
                                If Application.WorksheetFunction.CountA(Range(Cells( _
Zei_Vertretung, Spa1), _
                                        Cells(Zei_Vertretung, Spa2))) = 0 Then
                                    arrListbox(Zei_List, 1) = Cells(Zei_Vertretung, Spa_Schicht) _
                                    arrListbox(Zei_List, 2) = Cells(Zei_Vertretung, Spa_Abt)
                                    arrListbox(Zei_List, 3) = Cells(Zei_Vertretung, Spa_Name)
                                    arrListbox(Zei_List, 4) = Zei_Vertretung
                                    Zei_List = Zei_List + 1
                                End If
                            Next
                            
                            With UF_Vertretung
                                
                                .txbAbt = Abt_Abwesend
                                .txbName = Name_Abw
                                .txbSchicht = Schicht_Abw
                                .txbDatum1 = Format(dat_1, "DD.MM.YYYY")
                                .txbDatum2 = Format(dat_2, "DD.MM.YYYY")
                                If Zei_List > LBound(arrListbox, 1) Then
                                    .lbxVertretung.List = arrListbox
                                    With .lbxVertretung
                                    'leere Zeilen der Auswahlliste löschen
                                    For Zei_List = .ListCount - 1 To 0 Step -1
                                        If .List(Zei_List, 2) = "" Then
                                            .RemoveItem (Zei_List)
                                        Else
                                            Exit For
                                        End If
                                    Next
                                    End With
                                End If
                                
                                .Show
                                If .Tag = "OK" Then
                                    Zei_Vertretung = Val(.lbxVertretung.value)
                                    'Zellen bei abwesender Person färben
                                    With Range(Cells(Zei_Abwesend, Spa1), Cells(Zei_Abwesend,  _
Spa2))
                                        .Interior.Color = Cells(Zei_Vertretung, Spa_Farbe). _
Interior.Color
                                    End With
                                    'Zellen bei Vertreter färben und Abteilung der vertretenen  _
Person eintragen
                                    With Range(Cells(Zei_Vertretung, Spa1), Cells( _
Zei_Vertretung, Spa2))
                                        .value = Abt_Abwesend
                                        .Interior.Color = Cells(Zei_Vertretung, Spa_Farbe). _
Interior.Color
                                    End With
                                End If
                                Unload UF_Vertretung
                            End With
                        Case Else
                            'do nothing
                    End Select
                
                Case Else
                    'do nothing
            End Select
        End If
    End With
    
End Sub

Bild

Betrifft: AW: Zwei ursprüngliche Rechtsklickereignisse handhaben
von: Daniel
Geschrieben am: 25.05.2015 14:07:20
Hi
dann schreibe den Code doch direkt in das Click-Event des Userformbuttons.
musst halt TARGET durch ACTIVECELL ersetzen und ggf noch eine Prüfung einbauen, ob du auf dem richtigen Blatt bist.
Gruß Daniel

Bild

Betrifft: AW: Zwei ursprüngliche Rechtsklickereignisse handhaben
von: Torsten
Geschrieben am: 26.05.2015 00:38:59
Hat leider niocht geklappt.
Ich würde diesen Code gerne in eine Modul setzen und ihn mit einem Commondbutton anstoßen.
Das Thema habe ich in einem anderen Thread nochmal angesprochen.
Betreff: "Zellenmarkierung mittels Userform"

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Spalten löschen mit VBA"