Kleine Anleitung zur Vorgehensweise...
06.09.2016 09:44:14
Michael
Guten Morgen URÜ!
Na perfekt, dann gehe vor wie folgt... Die Makros kommen in Deine original Eingabe-Datei, die Protokoll-Datei enthält keine Makros (zumindest nicht für diesen Zweck).
Richte Dir eine Protokoll-Datei ein, wie Du sie brauchst, und zwar mit je einem Tabellenblatt pro Eingabe-Blatt (idF also 7 Tabellenblätter) - die Bezeichnung der Tabellenblätter ist für die Protokollierung unerheblich, nicht allerdings die Reihenfolge; Du siehst weiter unten warum. Sollte das für Dich problematisch sein, und Du möchtest lieber mit den Blattbezeichnungen arbeiten, ist auch das problemlos machbar.
In Deiner original Eingabe-Datei machst Du nun Folgendes:
1) Öffne die Datei und speichere diese zunächst als ".xlsm" ab, bzw. unter Excel 2003 als Datei mit Makros.
2) Begib Dich mit Alt + F11 in die VBA-Entwicklungsumgebung. Im neuen Fenster siehst Du links oben eine Art Explorer-Ansicht, unter der Du auch Deine Mappe finden solltest, in der Form "VBA-Project(DeineMappe.xlsm)".
3) Sofern in der Explorer-Ansicht unterhalb Deiner Mappe noch keine Tabellen o.Ä. zu sehen sind, führe einen Doppelklick auf die Mappe aus. Es öffnen sich dann darunter Dinge wie "DieseArbeitsmappe" und diverse "Tabellen1 (Tabelle1)" etc.
4) Führe einen Doppelklick auf "DieseArbeitsmappe" aus. Füge dort folgenden Code ein:
Private Sub Workbook_Open()
'Sicherstellen, dass die Protokoll-Datei parallel geöffnet ist
Application.ScreenUpdating = False
If Not IsProtocolOpen Then Workbooks.Open (PROT_PFAD & PROT_DATEI)
Me.Activate
Application.ScreenUpdating = True
End Sub
5) Führe nun in der Exploreransicht einen Doppelklick auf jedes Tabellenblatt (Tabelle1 (Tabelle1) bzw. Tabelle1 (DeinBlattname) ) aus, dass protokolliert werden soll. Jedesmal fügst Du diesen Code ein
Private Sub Worksheet_Change(ByVal Target As Range)
'Protokollierung der X/Y-Eingaben in Protokoll-Datei
Dim WbP As Workbook
Dim nRow&, nCol&
Set WbP = Workbooks(PROT_DATEI)
nRow = Target.Row
If Target.Cells.Count = 1 And Target.Column = 6 Or Target.Column = 10 Then
'Bestimmung des Ziel-Blatts in der Protokoll-Datei...
With WbP.Worksheets(1) '... hier wird auf dem 1. Blatt der Protokoll-Datei gesichert
'With WbP.Worksheets(2)'... hier wird auf dem 2. Blatt der Protokoll-Datei gesichert
'With WbP.Worksheets(3)'...hier wird auf dem 3. Blatt der Protokoll-Datei gesichert
'usw. usf
Select Case Target.Column
Case Is = 6 'X
Select Case XY
Case Is = 1 'Es findet ein ERSTEINTRAG statt
.Cells(nRow, 1).Value = Format(TimeValue(Now), "hh:mm:ss")
.Cells(nRow, 2).Value = Target.Value
Case Is = 2 'Es findet ein ZWEITEINTRAG statt
.Cells(nRow, 4).Value = Format(TimeValue(Now), "hh:mm:ss")
.Cells(nRow, 5).Value = Target.Value
.Cells(nRow, 6).Value = Target.Offset(, 4).Value
Case Is = 3 'Es findet ein FOLGEEINTRAG statt
nCol = .Cells(nRow, .Columns.Count).End(xlToLeft).Column + 1
.Cells(nRow, nCol) = Format(TimeValue(Now), "hh:mm:ss")
.Cells(nRow, nCol + 1) = Target.Value
.Cells(nRow, nCol + 2) = Target.Offset(, 4).Value
End Select
Case Is = 10 'Y
Select Case XY
Case Is = 1 'Es findet ein ERSTEINTRAG statt
.Cells(nRow, 1).Value = Format(TimeValue(Now), "hh:mm:ss")
.Cells(nRow, 3).Value = Target.Value
Case Is = 2 'Es findet ein ZWEITEINTRAG statt
.Cells(nRow, 4).Value = Format(TimeValue(Now), "hh:mm:ss")
.Cells(nRow, 5).Value = Target.Offset(, -4).Value
.Cells(nRow, 6).Value = Target.Value
Case Is = 3 'Es findet ein FOLGEEINTRAG statt
nCol = .Cells(nRow, .Columns.Count).End(xlToLeft).Column + 1
.Cells(nRow, nCol) = Format(TimeValue(Now), "hh:mm:ss")
.Cells(nRow, nCol + 1) = Target.Offset(, -4).Value
.Cells(nRow, nCol + 2) = Target.Value
End Select
End Select
End With
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Prüfung auf aktuellen Eingabe-Status
With Target
If .Cells.Count = 1 And .Column = 6 Or .Column = 10 Then
Select Case .Column
Case Is = 6 'X-Eingabe
Select Case IsEmpty(.Value)
Case True
Select Case IsEmpty(.Offset(, 4).Value)
'X ist leer, Y ist leer
'ERSTEINTRAG
Case Is = True
XY = Erst
'X ist leer, Y ist voll
'ZWEITEINTRAG
Case Is = False
XY = Zweit
End Select
Case False
Select Case IsEmpty(.Offset(, 4).Value)
'X ist voll, Y ist leer
'ZWEITEINTRAG
Case Is = True
XY = Zweit
'X ist voll, Y ist voll
'FOLGEEINTRAG
Case Is = False
XY = Folge
End Select
End Select
Case Is = 10 'Y-Eingabe
Select Case IsEmpty(.Value)
Case True
Select Case IsEmpty(.Offset(, -4).Value)
'X ist leer, Y ist leer
'ERSTEINTRAG
Case Is = True
XY = Erst
'X ist voll, Y ist leer
Case Is = False
'ZWEITEINTRAG
XY = Zweit
End Select
Case False
Select Case IsEmpty(.Offset(, -4).Value)
'X ist leer, Y ist voll
'ZWEITEINTRAG
Case Is = True
XY = Zweit
'X ist voll, Y ist voll
'FOLGEEINTRAG
Case Is = False
XY = Folge
End Select
End Select
End Select
End If
End With
End Sub
Im o.a. Code musst Du nun jeweils anpassen, auf welchem Blatt in der Protokoll-Datei die Eingabe dieses Blattes protokolliert werden sollen. Das ist auch kommentiert im Code, Du musst diese Zeile oben im Code anpassen:
With WbP.Worksheets(1)
In diesem Fall werden die Eingaben auf das erste (!) Blatt (in der Reihenfolge von links nach rechts der Tabellenblattreiter) übertragen/protokolliert. Analog kannst Du also schreiben
With WbP.Worksheets(2)
um die Eingaben auf dem 2. Blatt der Protokoll-Datei zu sichern. Usw. usf.
Wenn Du lieber mit den konkreten Blattbezeichnungen arbeiten willst, dann müsstest Du das so anpassen:
With WbP.Worksheets("Lorem")
In diesem Fall würden die Eingaben in der Protokoll-Datei auf dem Tabellenblatt "Lorem" protokolliert; beachte aber, dass dieses Blatt dann auch genauso vorhanden sein muss (eine entsprechende Prüfung hab ich Dir jetzt noch nicht eingebaut).
6) Füge nun über die Menüleiste der Entwicklungsumgebung unter Einfügen - Modul ein allgemeines Modul ein. Dort fügst Du folgenden Code ein:
Public Enum Stati: Erst = 1: Zweit = 2: Folge = 3: End Enum
'--- Anpassen ---
Public Const PROT_DATEI As String = "Protokoll.xlsx"
Public Const PROT_PFAD As String = "U:\Test\"
'--- Ende ---
Public XY As Stati
Function IsProtocolOpen() As Boolean
'Prüfung ob Protokoll-Datei geöffnet ist
Dim Wb As Workbook
For Each Wb In Application.Workbooks
If Wb.Name = PROT_DATEI Then IsProtocolOpen = True
Next Wb
End Function
Wie schon gewohnt, ändere hier bitte die Werte für den Namen der Protokoll-Datei sowie den Speicherpfad der Protokoll-Datei (die Pfadangabe muss mit "\" enden!).
7) Speichere die Datei, schließe die Datei und öffne die Datei nochmals. Es sollte nun die zugehörige Protokoll-Datei aufgerufen werden und Du kannst testen, ob die Eingaben richtig übernommen werden.
Hier noch als Beispiel für 7 Tabellenblätter in einem .zip-Archiv: https://www.herber.de/bbs/user/108040.zip
Viel Erfolg!
Michael
