Änderungshistorie verändern
05.04.2019 09:58:57
Chris
'Was steht in welcher Spalte
'Spalten der Tabelle Änderungshistorie
Private Const sDatum = 2
Private Const sTyp = 3
Private Const sID = 1
Private Const sARID = 4 'spalte Änderungdhistorie Reifen ID
Private Const sReifen = 5
Private Const sSpalte = 6
Private Const sAenderung = 7
Private Const sErsteller = 8
'Spalte in der, der Hersteller, die Sachnummer usw. steht
Private Const sDimension = 2
Private Const sSachnr = 14
Private Const sHersteller = 15
Private Const sRoWi = 18
Private Const sRID = 1
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim Rng As Range
Dim letzteZeileSicherungskopie As Long, letzteZeile As Long, letzteSpalte As Long
Dim i As Long, j As Long, i_tmp As Long
Dim tmpStrValue As String, tmpStrColumn As String, Reifen As String, Praefix As String 'Für _
_
Änderungshistorie
Dim Baureihe As String
Dim RoWi As Worksheet, Kopie As Worksheet, Historie As Worksheet
Dim Hinzugefügt As Boolean 'sagt aus ob der reifen neu hinzugefügt wurde oder nicht
Dim ID As Integer, RID As String 'Für Änderungshistorie
Hinzugefügt = True
Set RoWi = Worksheets("RoWi-Tabelle")
Set Kopie = Worksheets("Kopie")
Set Historie = Worksheets("Änderungshistorie")
Historie.Unprotect Password:="7sieben7"
Baureihe = Range("G4")
If RoWi.FilterMode Then RoWi.ShowAllData 'Filter zurücksetzen wenn welche gesetzt _
waren
If Kopie.FilterMode Then Kopie.ShowAllData
letzteZeile = RoWi.Cells(Rows.Count, 1).End(xlUp).Row
letzteZeileSicherungskopie = Kopie.Cells(Rows.Count, 1).End(xlUp).Row
letzteSpalte = RoWi.Cells(4, Columns.Count).End(xlToLeft).Column
'nach zoll größe sortieren
Call Sortieren
For i_tmp = 9 To letzteZeile
For i = 9 To letzteZeileSicherungskopie
If RoWi.Cells(i_tmp, 1) = Kopie.Cells(i, 1) Then 'Überprüfen ob _
_
etwas geändert wurde(Vergleich RoWi-Tabelle vs. Kopie Tabelle)
Hinzugefügt = False
For j = 1 To letzteSpalte
'Wurde etwas in bei dem reifen verändert
If RoWi.Cells(i_tmp, j).text Kopie.Cells(i, j).text Then
'Schauen ob der Reifen schon in der Reifen spalte steht
'NEIN: hinzufüden
If InStr(Reifen, RoWi.Cells(i_tmp, sRID).text) = 0 Then
Praefix = "Geändert"
Reifen = RoWi.Cells(i_tmp, sDimension).text & " " & RoWi.Cells( _
i_tmp, sHersteller).text
RID = RoWi.Cells(i_tmp, sRID).text
End If
tmpStrValue = tmpStrValue + "Alt: " + Kopie.Cells(i, j).text + "; Neu: " _
_
+ RoWi.Cells(i_tmp, j).text + vbLf
If j "" Then
Call HistorieFuellen(Historie, Praefix, RID, Reifen, tmpStrColumn, _
tmpStrValue)
End If
End If
Next i
If Hinzugefügt = True Then
'es wurde eine Zeile hinzugefügt
Praefix = "Hinzugefügt"
Reifen = RoWi.Cells(i_tmp, sDimension).text & " " & RoWi.Cells(i_tmp, sHersteller). _
_
text
RID = RoWi.Cells(i_tmp, sRID).text
Call HistorieFuellen(Historie, Praefix, RID, Reifen, tmpStrColumn, tmpStrValue)
End If
Hinzugefügt = True
Next i_tmp
For i = 9 To letzteZeileSicherungskopie
For i_tmp = 9 To letzteZeile
If RoWi.Cells(i_tmp, sRID).text = Kopie.Cells(i, sRID) Then
GoTo Nächster
End If
Next i_tmp
' Zeile wurden gelöscht
Praefix = "Gelöscht"
Reifen = Kopie.Cells(i, sDimension).text & " " & Kopie.Cells(i, sHersteller).text
RID = Kopie.Cells(i, sRID).text
Call HistorieFuellen(Historie, Praefix, RID, Reifen, tmpStrColumn, tmpStrValue)
Nächster:
Next i
weiter:
RoWi.Range("A1:DZ999").Copy
With Kopie
.Cells(1, 1).PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
Historie.Protect Password:="7sieben7", AllowFiltering:=True
End Sub
Sub HistorieFuellen(Historie As Worksheet, Praefix As String, RID As String, Reifen As String, tmpStrColumn As String, tmpStrValue As String)
If Historie.Cells(6, sID) = "" Then
ID = 1
Else
ID = Historie.Cells(6, sID) + 1
End If
'neue Zeile einfügen
Historie.Rows(6).Insert Shift:=xlDown
Historie.Rows(7).Copy
Historie.Rows(6).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
' Präfix
Historie.Cells(6, sTyp) = Praefix
' Änderungs-Datum
Historie.Cells(6, sDatum) = Now
' Index des Datensatzes
Historie.Cells(6, sID) = ID
'ID des Reifens
Historie.Cells(6, sARID) = RID
' Reifen-Bezeichnung
Historie.Cells(6, sReifen) = Reifen
' Spalte der Änderung
Historie.Cells(6, sSpalte) = tmpStrColumn
' Geänderte Werte
Historie.Cells(6, sAenderung) = tmpStrValue
' Änderungs-Autor
Historie.Cells(6, sErsteller) = Application.UserName
Praefix = ""
RID = ""
Reifen = ""
tmpStrValue = ""
tmpStrColumn = ""
End Sub