Zellenmarkierung mittels Userform

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

Betrifft: Zellenmarkierung mittels Userform
von: Torsten
Geschrieben am: 23.05.2015 21:28:31

Habe eine Frage an die Hartgesottenen.
Ich habe einen Anwesenheitsplaner erstellt.
In diesem soll unter anderem die Vertretung geplant werden.
Dies soll mittels Userform / Abfrage laufen.
Ich markiere einen bestimmen Bereich einer zu vertretenden Person.
Nun wähle ich in der sich öffnenden Userform einen Vertreter aus.
Nun wird sowohl bei der zu vertretenden Person als auch bei dem Vertreter in eine vorgegebene Farbe eingefärbt.
Was meint ihr?
Ist sowas möglich und habt ihr Ideen wie das Ganze als VBA aussehen würde?
Anbei das Beispiel:
https://www.herber.de/bbs/user/97800.xlsx
Beste Grüße
Torsten

Bild

Betrifft: AW: Zellenmarkierung mittels Userform
von: Torsten
Geschrieben am: 24.05.2015 00:17:11
Okay, die Anfrage ist etwas Unfangreich.
Im Grunde geht es mir darum:
Eine Tabelle wo links in den Zeilen Namen stehen.
Die Tabellenspalten sind mit dem fortlaufenden Datum beschriftet.
Ich möchte nun bei einem Namen einem bestimmten Spaltenbereich (Datumsbereich) farblich markieren.
Am Ende soll der zuerst gewählte Spaltenbereich und der gleiche gewählte Spaltenbereich, jedoch nur bei einem weiteren Namen in der Tabelle markiert sein.
Am Ende möchte ich somit bei beiden gewählten Namen sagen, das sie z.B. vom 2.5.2014 bis 8.5.2015 ein gemeinsames Ereignis haben.

Bild

Betrifft: AW: Zellenmarkierung mittels Userform
von: fcs
Geschrieben am: 24.05.2015 11:25:49
Hallo Thorsten,
hier deine Datei mit Makros (unter dem Blatt Planer) und einem Userform.
https://www.herber.de/bbs/user/97803.xlsm
Gruß
Franz

Bild

Betrifft: AW: Zellenmarkierung mittels Userform
von: Torsten
Geschrieben am: 24.05.2015 14:38:49
Vielen lieben Dank.
Das ist richtig Super!
Genau so habe ich es mir vorgestellt.
Danke danke danke!
Wie bekommt man sowas so rasant hin?
Wie macht ihr alle das und wo kann ich sowas lernen?

Bild

Betrifft: Zellenmarkierung mittels Userform
von: Torsten
Geschrieben am: 26.05.2015 00:34:28
Habe ich auch die Möglichkeit diesen Code in einem Modul zu öffnen?
Der Code wurde mir von einem User hier im Forum geschrieben.
Ein weiteres Ereignis mit Target (Rechtsklick) welches im Tabellenblatt liegt benötige ich dringend, welches sich mit diesem Ereignis Rechtsklick nicht verträgt.
Ich habe versucht "Target" gegen "Activecell" zu ersetzen, aber leider ohne Erfolg.
Ich möchte den folgenden Code dann Anschließend über ein Commondbutton_Click1 öffnen.
Die bereits erstellte Datei/funktionierende Datei ist im Verlauf dieses Threads vom User "fcs" erstellt.

Private Sub Worksheet_BeforeRightClick(ByVal Target As 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& = 3  'Spalte C - Spalte mit Abteilung
    Const Spa_Abt& = 4      'Spalte D - Spalte mit Abteilungen
    Const Spa_Name& = 5     'Spalte E - Spalte mit Namen
    Const Spa_Datum1& = 6   'Spalte F - 1. Spalte mit einem Kalender-Datum
    
    Const Zei_Name1& = 6    ' 1. Zeile mit einem Namen
    Const Zei_Datum& = 5    '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: Zellenmarkierung mittels Userform
von: fcs
Geschrieben am: 26.05.2015 14:16:09
Hallo Thorsten,
der Code kann umgeschrieben werden, so dass das Makro über eine Schaltfläche gestartet werden kann.
Ich empfehle hier eine Schaltfläche aus den Formular-Steuerelementen.
Gruß
Franz

'Code in einem allgemeinen Modul
Sub prcVertreterFaerben()
    Dim wks As Worksheet, rngBereich As Range
    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& = 3  'Spalte C - Spalte mit Abteilung
    Const Spa_Abt& = 4      'Spalte D - Spalte mit Abteilungen
    Const Spa_Name& = 5     'Spalte E - Spalte mit Namen
    Const Spa_Datum1& = 6   'Spalte F - 1. Spalte mit einem Kalender-Datum
    
    Const Zei_Name1& = 6    ' 1. Zeile mit einem Namen
    Const Zei_Datum& = 5    'Zeile mit Datumswerten
    
    Set wks = ActiveWorkbook.Worksheets("Planer")
    If ActiveSheet.Name <> wks.Name Then
      MsgBox "Bei Ausführung dieses Makros muss das Blatt """ & wks.Name _
            & """ das aktive Blatt sein!"
      Exit Sub
    End If
    Set rngBereich = Selection
    With wks
      Zei_L = .Cells(.Rows.Count, Spa_Name).End(xlUp).Row
      Spa_L = .Cells(Zei_Datum, .Columns.Count).End(xlToLeft).Column
    End With
    With rngBereich
      'Prüfung, ob nur Zellen in einer Zeile markiert wurden und 1. Zelle des _
            Bereichs Inhalt hat.
      If .Rows.Count = 1 And .Cells(1, 1) <> "" Then
        Select Case .Column
          Case Spa_Datum1 To Spa_L
            Select Case .Row
              Case Zei_Name1 To Zei_L
                  
                  Spa1 = .Column
                  Spa2 = Spa1 + .Columns.Count - 1
                  Zei_Abwesend = .Row
                  With wks
                    Abt_Abwesend = .Cells(Zei_Abwesend, Spa_Abt).Value
                    Name_Abw = .Cells(Zei_Abwesend, Spa_Name).Text
                    Schicht_Abw = .Cells(Zei_Abwesend, Spa_Schicht).Value
                    dat_1 = .Cells(Zei_Datum, Spa1).Value
                    dat_2 = .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
                  End With 'wks
                  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)
                          With wks
                            'Zellen bei abwesender Person färben
                            With .Range(.Cells(Zei_Abwesend, Spa1), .Cells(Zei_Abwesend, Spa2))
                              .Interior.Color = wks.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 = wks.Cells(Zei_Vertretung, Spa_Farbe).Interior. _
Color
                            End With
                          End With 'wks
                      End If
                      Unload UF_Vertretung
                  End With 'UF_Vertretung
              Case Else
                'do nothing
            End Select
        
          Case Else
            'do nothing
        End Select
      End If
    End With 'rngBereich
End Sub


Bild

Betrifft: AW: Zellenmarkierung mittels Userform
von: Torsten
Geschrieben am: 26.05.2015 21:55:36
Hey Daniel,
das war eine Superleistung.
Vielen vielen Dank!

Bild

Betrifft: AW: Zellenmarkierung mittels Userform
von: fcs
Geschrieben am: 27.05.2015 09:15:53
Hallo Thorsten,
der Name des Helfers ist nicht Daniel.
Trotzdem vielen Dank für das Lob.
Gruß
Franz

Bild

Betrifft: AW: Zellenmarkierung mittels Userform
von: Torsten
Geschrieben am: 27.05.2015 11:47:42
Na da siehst du mal wie mich dieses ganze Thema schon belastet hat.
Hoffentlich wird mir der Namensverwechsler nicht bei meiner Frau passieren. Dann gibt's Ärger.
Danke Franz.

Bild

Betrifft: AW: Zellenmarkierung mittels Userform
von: Torsten
Geschrieben am: 27.05.2015 15:18:18
Gibt es jetzt evtl. noch die Möglichkeit die jeweiligen Aktionen/Veränderungen im Kommentar zu speichern.
Ich habe es versucht. Es wird zwar ein Kommentar geschrieben, aber in ganz anderen Zellen als vorgesehen.
Ich möchte das alle veränderten Zellen (alle markierten Zellen des zu Vetretenden und die des Vertreters)
einen Kommentar erhalten.Diesen Nutze ich als Historie.
Vielleicht ist es euch möglich diesen Code einzubinden.

Private Sub CommandButton3_Click()
Dim objZelle As Range
Dim sAlt As String
Dim sNeu As String
    sNeu = InputBox("Geben Sie einen Kommentar ein", "Kommentar ergänzen") 'wäre in diesem Fall  _
ein fester Wert "Vetretung geplant"
        
        If sNeu = "" Then Exit Sub
        For Each objZelle In Selection
        With objZelle
        On Error Resume Next
        sAlt = ""
        sAlt = .Comment.text
        On Error GoTo 0
        If sAlt = "" Then .AddComment
        .Comment.text sAlt & Application.UserName _
        & Date & "/" & Time & "=" & ">" & sNeu & "<" & Chr(10)
        .Comment.Visible = False
        .Comment.Shape.TextFrame.AutoSize = True
        .Comment.Shape.TextFrame.Characters.Font.Size = 8
        End With
 
Next
Unload frm_Grund
End Sub


Bild

Betrifft: AW: Zellenmarkierung mittels Userform
von: Torsten
Geschrieben am: 27.05.2015 15:18:28
Gibt es jetzt evtl. noch die Möglichkeit die jeweiligen Aktionen/Veränderungen im Kommentar zu speichern.
Ich habe es versucht. Es wird zwar ein Kommentar geschrieben, aber in ganz anderen Zellen als vorgesehen.
Ich möchte das alle veränderten Zellen (alle markierten Zellen des zu Vetretenden und die des Vertreters)
einen Kommentar erhalten.Diesen Nutze ich als Historie.
Vielleicht ist es euch möglich diesen Code einzubinden.

Private Sub CommandButton3_Click()
Dim objZelle As Range
Dim sAlt As String
Dim sNeu As String
    sNeu = InputBox("Geben Sie einen Kommentar ein", "Kommentar ergänzen") 'wäre in diesem Fall  _
ein fester Wert "Vetretung geplant"
        
        If sNeu = "" Then Exit Sub
        For Each objZelle In Selection
        With objZelle
        On Error Resume Next
        sAlt = ""
        sAlt = .Comment.text
        On Error GoTo 0
        If sAlt = "" Then .AddComment
        .Comment.text sAlt & Application.UserName _
        & Date & "/" & Time & "=" & ">" & sNeu & "<" & Chr(10)
        .Comment.Visible = False
        .Comment.Shape.TextFrame.AutoSize = True
        .Comment.Shape.TextFrame.Characters.Font.Size = 8
        End With
 
Next
Unload frm_Grund
End Sub


Bild

Betrifft: AW: Zellenmarkierung mittels Userform
von: Torsten
Geschrieben am: 27.05.2015 15:22:31
Gibt es jetzt evtl. noch die Möglichkeit die jeweiligen Aktionen/Veränderungen im Kommentar zu speichern.
Ich habe es versucht. Es wird zwar ein Kommentar geschrieben, aber in ganz anderen Zellen als vorgesehen.
Ich möchte das alle veränderten Zellen (alle markierten Zellen des zu Vetretenden und die des Vertreters)
einen Kommentar erhalten.Diesen Nutze ich als Historie.
Vielleicht ist es euch möglich diesen Code einzubinden.

Private Sub CommandButton3_Click()
Dim objZelle As Range
Dim sAlt As String
Dim sNeu As String
    sNeu = InputBox("Geben Sie einen Kommentar ein", "Kommentar ergänzen") 'wäre in diesem Fall  _
ein fester Wert "Vetretung geplant"
        
        If sNeu = "" Then Exit Sub
        For Each objZelle In Selection
        With objZelle
        On Error Resume Next
        sAlt = ""
        sAlt = .Comment.text
        On Error GoTo 0
        If sAlt = "" Then .AddComment
        .Comment.text sAlt & Application.UserName _
        & Date & "/" & Time & "=" & ">" & sNeu & "<" & Chr(10)
        .Comment.Visible = False
        .Comment.Shape.TextFrame.AutoSize = True
        .Comment.Shape.TextFrame.Characters.Font.Size = 8
        End With
 
Next
Unload frm_Grund
End Sub


Bild

Betrifft: AW: Zellenmarkierung mittels Userform
von: Torsten
Geschrieben am: 27.05.2015 15:34:18
Huppalla.
Drei mal der gleiche Beitrag war nicht gewollt.

Bild

Betrifft: AW: Zellenmarkierung mittels Userform
von: Torsten
Geschrieben am: 27.05.2015 19:36:52
Bevor ich es vergesse..
Alles was ich hier so einsetze, habe ich als Beispieltabellen hochgeladen oder wurden von anderen Usern bereits hochgeladen.

Bild

Betrifft: AW: Zellenmarkierung mittels Userform
von: Torsten
Geschrieben am: 28.05.2015 00:32:33
Na, da habe ich es doch noch selbst hinbekommen.
Thema erledigt

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Zellenmarkierung mittels Userform"