Datum bei Änderung

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

' ********************************************************************** ' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...) ' ********************************************************************** Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range On Error GoTo ErrExit If Not Intersect(Target, Range("H4:H1001")) Is Nothing Then Application.EnableEvents = False Me.Unprotect 'ggf. Passwort angeben For Each rng In Intersect(Target, Range("H4:H1001")) If Cells(rng.Row, 3) = "" Then Cells(rng.Row, 3) = Date Else Cells(rng.Row, Application.Max(17, Cells(rng.Row, _ Columns.Count).End(xlToLeft).Column + 1)) = Date End If Next Me.Protect 'ggf. Passwort angeben End If ErrExit: Application.EnableEvents = True End Sub

Hallo Sepp,
Zum Schutz (Sperren) einzelner ausgeblendeter Spalten/Zeilen gehe ich wie folgt vor
Beispiel: Spalte Q bis U soll ausgeblendet und geschützt werden.
(kann dann nicht ohne Kennwort nicht eingeblendet werden)
- Spalte Q bis U ausblenden
- Tabellenblatt komplett markieren (links oben)
- Format Zellen formatieren Schutz Haken bei Gesperrt entfernen.
- Die zu schützenden Spalten markieren. Da ausgeblendet incl. der leeren Spalten P und V.
- Format Zellen formatieren Schutz Haken in Gesperrt setzen
- Überprüfen Blatt schützen Kennwort eingeben Haken bei gesperrte Zellen entfernen*.
- Ok
Fertig ist der Schutz
Um einzelne Zellen zu schützen gehe ich ebenso vor.
Da einzelne Zellen nicht ausgeblendet werden können, passe ich den Zelleninhalt der Hintergrundfarbe an. Und damit diese Zellen nicht angeklickt werden können nehme ich den Haken* bei gesperrte Zellen raus. Somit ist der Zelleninmhalt auch nicht in der Bearbeitungsleiste zu sehen.
Gruß
Werner

Hallo Werner,
dann versuche es so.


' **********************************************************************
' Modul: Tabelle3  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range
  Dim lngLast As Long
  On Error GoTo ErrExit
  
  If Not Intersect(Target, Range("H4:H1001")) Is Nothing Then
    Application.EnableEvents = False
    Me.Unprotect "test"
    For Each rng In Intersect(Target, Range("H4:H1001"))
      If Cells(rng.Row, 3) = "" Then
        Cells(rng.Row, 3) = Date
      Else
        lngLast = Application.Max(17, lastCell(Me, rng.Row, False) + 1)
        Cells(rng.Row, lngLast) = Date
      End If
    Next
    Me.Protect "test"
  End If
  
  ErrExit:
  Application.EnableEvents = True
End Sub


Private Function lastCell(ByRef sh As Worksheet, ByRef ColOrRow As Long, Optional LastRow As Boolean = True) As Long
  On Error GoTo ErrExit
  
  With sh
    If ColOrRow < 1 Or (LastRow And ColOrRow > .Rows.Count) Or _
      (Not LastRow And ColOrRow > .Columns.Count) Then Exit Function
    .Parent.CustomViews.Add "##TempView##", False, True
    If LastRow Then
      .Rows.Hidden = False
      If .AutoFilterMode Then If .FilterMode Then .ShowAllData
      If .Cells(.Rows.Count, ColOrRow) <> "" Then
        lastCell = .Rows.Count
      Else
        lastCell = .Cells(.Rows.Count, ColOrRow).End(xlUp).Row
      End If
    Else
      .Columns.Hidden = False
      If .Cells(ColOrRow, .Columns.Count) <> "" Then
        lastCell = .Columns.Count
      Else
        lastCell = .Cells(ColOrRow, .Columns.Count).End(xlToLeft).Column
      End If
    End If
    ErrExit:
    On Error Resume Next
    With .Parent.CustomViews("##TempView##")
      .Show
      .Delete
    End With
    On Error GoTo 0
  End With
End Function

« Gruß Sepp »

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Datum bei Änderung

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread