Microsoft Excel

Herbers Excel/VBA-Archiv

2 verschieden VBAs zusammen bringen, laufen lassen


Betrifft: 2 verschieden VBAs zusammen bringen, laufen lassen
von: Frank Wegmann
Geschrieben am: 28.11.2018 20:58:09

Hallo zusammen,

ich benötige eure Hilfe.

Ich habe den VBA-Code:



Private Sub Workbook_Open()
Dim raZelle As Range, raBereich As Range
    With Worksheets("Kalender")
        .Unprotect "dragon"
        Set raBereich = .Range("C7:C217")
        For Each raZelle In raBereich
            If raZelle.Value < .Range("A5").Value Then
                raZelle.Offset(0, 1).Resize(1, 33).Locked = True
            End If
        Next raZelle
        Set raBereich = .Range("H7:H217")
        For Each raZelle In raBereich
            If raZelle.Value < .Range("H6").Value Then
                raZelle.Offset(0, 1).Resize(1, 33).Locked = True
            End If
        Next raZelle
        .Protect "dragon"
    End With
End Sub

der mir die Zeilen nach bestimmten Kriterien sperrt.

Nun habe ich noch einen VBA-Code (s.u.) gefunden, der mir Änderungen, die im Reiter „Kalender“ vorgenommen werden, im Reiter „Protokolle“, protokollieren kann.

Wie bringe ich die beiden Codes zusammen, bzw. was muss ich wie eingeben, damit beide funktioniern?

Protokollierungs – VBA – Code :
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ErsteFreieZeile As Long
If Target.Count > 1 Then Exit Sub
If Sh.Name = "Protokoll" Then Exit Sub
If Intersect(Target, Sh.Range("A1:AK220")) Is Nothing Then Exit Sub
With Sheets("Protokoll")
    ErsteFreieZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(ErsteFreieZeile, 1) = Sh.Name
    .Cells(ErsteFreieZeile, 2) = Target.Address(0, 0)
    .Cells(ErsteFreieZeile, 3) = Target.Value
    .Cells(ErsteFreieZeile, 5) = Date
    .Cells(ErsteFreieZeile, 6) = Time
    .Cells(ErsteFreieZeile, 7) = Environ("username")
End With
End Sub

Einen angenehmen Abend
Frank

  

Betrifft: AW: 2 verschieden VBAs zusammen bringen, laufen lassen
von: Werner
Geschrieben am: 28.11.2018 22:08:42

Hallo Frank,

was meinst du denn mit zusammenbringen?
Der erste Code ist im Codemodul von "DieseArbeitsmappe" und wird beim Start der Datei ausgeführt und der zweite Code gehört ins Codmodul vom Blatt "Kalener" und du brauchst hier das Worksheet_Change Ereignis und nicht das Sheet_Change

Änderungen:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ErsteFreieZeile As Long

If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("A1:AK220")) Is Nothing Then Exit Sub
With Sheets("Protokoll")
    ErsteFreieZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .Cells(ErsteFreieZeile, 1) = Me.Name
    .Cells(ErsteFreieZeile, 2) = Target.Address(0, 0)
    .Cells(ErsteFreieZeile, 3) = Target.Value
    .Cells(ErsteFreieZeile, 5) = Date
    .Cells(ErsteFreieZeile, 6) = Time
    .Cells(ErsteFreieZeile, 7) = Environ("username")
End With
End Sub
Gruß Werner


  

Betrifft: AW: 2 verschieden VBAs zusammen bringen, laufen lassen
von: Frank Wegmann
Geschrieben am: 29.11.2018 18:42:48

Hallo Werner,

vielen Dank für die Information.
Jetzt habe ich wieder was gelernt und es funktioniert.

Gruß Frank


  

Betrifft: Gerne u. Danke für die Rückmeldung. o.w.T.
von: Werner
Geschrieben am: 29.11.2018 19:51:39