Antwort Thread auf: - Excel Makro
13.06.2019 14:03:17
Piet
ich habe deine letzte Nachricht im Archiv gefunden und eröffne für dich wie versprochen einen Antwort Thread.
Zu meiner grossen Überraschung sind in beiden Beispiel Dateien die Makros verloren gegangen! Das hatte ich noch nie. Beim Öffnen deiner Datei erhielt ich eine Fehlermeldung das mein Excel 2007 nicht alles korrekt laden konnte. Beim schliessen wurden AktiveX Komponenten kritisiert. Irgenwie geht da beim speichern was schief, verliert er immer nur die Tabellen Makros!
Hier der Target Code zum kopieren in die Schulungs Tabelle. So geht er wenigstens nicht verloren!! Der Code setzt voraus das in den anderen Tabellen: Stanzen usw. bei der passenden Maschinen Code-Nr. ein "1" gesetzt ist. Sonst kann ich die Dokumente nicht einwandfrei zuordnen. Es sind auch mehrere Prüfungen gegen Eingabefehler vorgesehen.
Würde mich freuen wenn es jetzt endlich klappt ... (die Dim Zeilen bitte mit Kopieren!)
mfg Pit
Option Explicit '13.6.2019 Piet für Herber Forum
Dim Sht As String, s As Integer 'Sheet, Zaehler
Dim MSCode As String, Txt As String 'Maschinen Code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Spa As Integer, Zei As Integer 'Spalte, Zeile
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Row 2 And Spa "" Then
MsgBox "In dieser Zeile gibt es bereits ein Dokument!" & _
Chr(10) & "'1' bitte von Hand löschen!", vbInformation
Target.Select: Exit Sub
End If
'Tabellen Namen aus Zeile 2 ermitteln
Sht = Cells(2, Target.Column).Value
If Sht = "" Then Sht = Cells(2, Target.Column).End(xlToLeft)
'Überschrift Spalte in aktiver Tabelle suchen
MSCode = Cells(4, Target.Column).Value
For s = 5 To 20 '** wieviele Spalten hat Stanzen?
If Worksheets(Sht).Cells(1, s) = MSCode Then Exit For
Next s
If s >= 20 Then
MsgBox Sht & " / " & MSCode & " Maschinen Code nicht gefunden!"
Target.Select: Exit Sub
End If
'Zelle mit "1" in aktiver Tabelle suchen
Zei = Worksheets(Sht).Cells(1, s).End(xlDown).Row
Txt = Worksheets(Sht).Cells(Zei, 2).Value
If Txt = Empty Then
MsgBox Sht & " / " & MSCode & " kein Dokument Text in dieser Zeile gefunden!"
Target.Select: Exit Sub
End If
If InStr(Txt, "Anzahl zu ") Then
MsgBox Sht & " / " & MSCode & " '1' in Spalte Maschinen Code nicht gefunden!"
Target.Select: Exit Sub
End If
'Dokument Name in Spalte Z schreiben
Application.EnableEvents = False
Cells(Target.Row, Spa + 1).Value = Txt
Application.EnableEvents = True
End If
End Sub