Sub Daten_speichern()
Worksheets.Application.ScreenUpdating = True
'Auftrag in die Dateien Auftrag.xls, Kunden.xls, Geraete.xls schreiben und speichern
Dim StatusCalc As Long
Dim wkbAuftrag As Workbook, wkbKunden As Workbook, wkbGeraete As Workbook, wkbLager As _
Workbook
Dim intFF As Integer, strDatei As String, varStartSpeichern, strText As String, strMsg As _
String
On Error GoTo fehler
StatusCalc = Application.Calculation
Set wkbAuftrag = Workbooks("Auftrag.xls")
Set wkbKunden = Workbooks("Kunden.xls")
Set wkbGeraete = Workbooks("Geraete.xls")
Set wkbLager = Workbooks("Lager.xls")
'Name der Infodatei zur Anzeige, dass ein andere User zur Zeit Auftrag speichert
strDatei = wkbAuftrag.Path & Application.PathSeparator & "Es_wird_gespeichert.txt"
ReStart:
If Dir(strDatei) = "" Then
'Start des Speichervorgangs in Textdatei schreiben
intFF = FreeFile
Open strDatei For Output As #intFF
Print #intFF, "User """ & VBA.Environ("Username") & """ bearbeitet zur Zeit die Dateien" _
_
Print #intFF, "Lager.xls, Auftrag.xls, Kunden.xls und Geraete.xls"
Print #intFF, "mit Makro ""prcSpeichern Auftrag"", Startzeit: " _
& Format(Now, "YYYY-MM-DD hh:mm:ss")
Close #intFF
'Makrobremsen lösen
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
Application.Calculate
'ab hier dann der bisherige Code zum Eintragen der Userform-Auftrag in die 3 Dateien
'falls zwingend erforderlich, zwischendurch Neuberechnungen einfügen.
Application.Calculation = xlCalculationManual
Dim Zahl As Long
Dim i As Long
Call Zuweisung
wksErfassung.Activate
If Range("ReparaturStatus") = 13 Then
MsgBox "KVA's können nicht mehr gespeichert werden"
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If
If Range("spe8") = "" Then
MsgBox "Es fehlt die Autragsnummer!", 0, "Antwortfenster"
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If
Windows("Erfassung.xls").Activate
Sheets("Eingabe Endkunde").Select
If Len(Cells(10, 2).Text) 7 Then
MsgBox "Die Auftragsnummer ist nicht korrekt!", 0, "Antwortfenster"
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If
If Range("Gerät") = "1" Then
If Range("Geraetenummer") > 0 Or Range("GeraeteNr") > "" Then
Call Geraet_speichern
Range("Gerät") = "0"
End If
End If
If Range("Kunde") = "1" Then
If Range("KundenNr") > "" Then
Call Kunde_speichern
Range("Kunde") = "0"
End If
End If
'**** Neu 2013.11.09****
If Range("ReparaturStatus") = "14" Then
Call Lager_löschen
End If
If Range("ReparaturStatus") = "12" Then
If Range("ReparaturStatus") Range("Speicher_Status") Then
If Range("GeraeteArt") = "Smartphone" Or Range("GeraeteArt") = "Tablet" Then
Else
Call Lager_löschen
Call Ausgang
End If
End If
End If
If Range("version") = 2 Then
If Range("GeraeteArt") = "Smartphone" Or Range("GeraeteArt") = "Tablet" Then
Call Lager_löschen
End If
End If
'**** Ende Neu 2013.11.09****
KundenNr = Range("KundenNr")
spe3 = Range("spe3")
spe8 = Range("spe8")
RechnungsNr = Range("RechnungsNr")
RechnungsDatum = Range("RechnungsDatum")
AuftragsDatum = Range("AuftragsDatum")
ReparaturStatus = Range("ReparaturStatus")
ExterneNummer = Range("ExterneNummer")
Geraetenummer = Range("Geraetenummer")
GeraeteZustand = Range("GeraeteZustand")
zubehoer = Range("Zubehoer")
GeraeteGarantie = Range("GeraeteGarantie")
Freigabe = Range("Freigabe")
KvaErstellen = Range("KvaErstellen")
BezogeneTassen = Range("BezogeneTassen")
GeraeteFehler1 = Range("Geraetefehler1")
GeraeteFehler2 = Range("GeraeteFehler2")
spe73 = Range("spe73")
spe74 = Range("spe74")
spe75 = Range("spe75")
spe76 = Range("spe76")
spe77 = Range("spe77")
spe78 = Range("spe78")
spe79 = Range("spe79")
spe80 = Range("spe80")
spe81 = Range("spe81")
spe82 = Range("spe82")
spe92 = Range("spe92")
spe93 = Range("spe93")
spe94 = Range("spe94")
Vorname = Range("Vorname")
spe116 = Range("spe116")
spe117 = Range("spe117")
Menge1 = Range("Menge1")
Menge2 = Range("Menge2")
Menge3 = Range("Menge3")
Menge4 = Range("Menge4")
Menge5 = Range("Menge5")
Menge6 = Range("Menge6")
Menge7 = Range("Menge7")
Menge8 = Range("Menge8")
Menge9 = Range("Menge9")
Menge10 = Range("Menge10")
Menge11 = Range("Menge11")
Menge12 = Range("Menge12")
Menge13 = Range("Menge13")
Menge14 = Range("Menge14")
Menge15 = Range("Menge15")
Menge16 = Range("Menge16")
Menge17 = Range("Menge17")
Menge18 = Range("Menge18")
Menge19 = Range("Menge19")
Menge20 = Range("Menge20")
Bez1 = Range("Bez1")
Bez2 = Range("Bez2")
Bez3 = Range("Bez3")
Bez4 = Range("Bez4")
Bez5 = Range("Bez5")
Bez6 = Range("Bez6")
Bez7 = Range("Bez7")
Bez8 = Range("Bez8")
Bez9 = Range("Bez9")
Bez10 = Range("Bez10")
Bez11 = Range("Bez11")
Bez12 = Range("Bez12")
Bez13 = Range("Bez13")
Bez14 = Range("Bez14")
Bez15 = Range("Bez15")
Bez16 = Range("Bez16")
Bez17 = Range("Bez17")
Bez18 = Range("Bez18")
Bez19 = Range("Bez19")
Bez20 = Range("Bez20")
ETeil1 = Range("ETeil1")
Eteil2 = Range("ETeil2")
Eteil3 = Range("ETeil3")
ETeil4 = Range("ETeil4")
ETeil5 = Range("ETeil5")
ETeil6 = Range("ETeil6")
ETeil7 = Range("ETeil7")
ETeil8 = Range("ETeil8")
ETeil9 = Range("ETeil9")
ETeil10 = Range("ETeil10")
ETeil11 = Range("ETeil11")
ETeil12 = Range("ETeil12")
ETeil13 = Range("ETeil13")
ETeil14 = Range("ETeil14")
ETeil15 = Range("ETeil15")
ETeil16 = Range("ETeil16")
ETeil17 = Range("ETeil17")
ETeil18 = Range("ETeil18")
ETeil19 = Range("ETeil19")
ETeil20 = Range("ETeil20")
BruttoEinzel1 = Range("BruttoEinzel1")
BruttoEinzel2 = Range("BruttoEinzel2")
BruttoEinzel3 = Range("BruttoEinzel3")
BruttoEinzel4 = Range("BruttoEinzel4")
BruttoEinzel5 = Range("BruttoEinzel5")
BruttoEinzel6 = Range("BruttoEinzel6")
BruttoEinzel7 = Range("BruttoEinzel7")
BruttoEinzel8 = Range("BruttoEinzel8")
BruttoEinzel9 = Range("BruttoEinzel9")
BruttoEinzel10 = Range("BruttoEinzel10")
BruttoEinzel11 = Range("BruttoEinzel11")
BruttoEinzel12 = Range("BruttoEinzel12")
BruttoEinzel13 = Range("BruttoEinzel13")
BruttoEinzel14 = Range("BruttoEinzel14")
BruttoEinzel15 = Range("BruttoEinzel15")
BruttoEinzel16 = Range("BruttoEinzel16")
BruttoEinzel17 = Range("BruttoEinzel17")
BruttoEinzel18 = Range("BruttoEinzel18")
BruttoEinzel19 = Range("BruttoEinzel19")
BruttoEinzel20 = Range("BruttoEinzel20")
Leihgerät = Range("Leihgerät")
JaNein = Range("JaNein")
Lagerplatz = Range("Lagerplatz")
stat = Range("stat")
brutto = Range("brutto")
Datum = Range("datum")
With wksAuftrag.Columns(1)
Set c = .Find(spe8, LookIn:=xlValues, LookAt:=xlWhole, _
SearchDirection:=xlNext, MatchCase:=False)
If Not c Is Nothing Then
Application.Goto c
GoTo weiter
End If
With .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1).EntireRow
.Cells(1, 1).Value = RechnungsNr
.Cells(1, 2).Value = KundenNr
.Cells(1, 3).Value = Geraetenummer
.Cells(1, 4).Value = ExterneNummer
.Cells(1, 5).Value = AuftragsDatum
.Cells(1, 6).Value = RechnungsDatum
.Cells(1, 7).Value = ReparaturStatus
.Cells(1, 8).Value = spe3
.Cells(1, 9).Value = GeraeteZustand
.Cells(1, 10).Value = zubehoer
.Cells(1, 11).Value = Freigabe
.Cells(1, 12).Value = KvaErstellen
.Cells(1, 13).Value = BezogeneTassen
.Cells(1, 14).Value = GeraeteFehler1
.Cells(1, 15).Value = GeraeteFehler2
.Cells(1, 16).Value = Datum
.Cells(1, 17).Value = Menge1
.Cells(1, 18).Value = Bez1
.Cells(1, 19).Value = ETeil1
.Cells(1, 20).Value = BruttoEinzel1
.Cells(1, 21).Value = Menge2
.Cells(1, 22).Value = Bez2
.Cells(1, 23).Value = Eteil2
.Cells(1, 24).Value = BruttoEinzel2
.Cells(1, 25).Value = Menge3
.Cells(1, 26).Value = Bez3
.Cells(1, 27).Value = Eteil3
.Cells(1, 28).Value = BruttoEinzel3
.Cells(1, 29).Value = Menge4
.Cells(1, 30).Value = Bez4
.Cells(1, 31).Value = ETeil4
.Cells(1, 32).Value = BruttoEinzel4
.Cells(1, 33).Value = Menge5
.Cells(1, 34).Value = Bez5
.Cells(1, 35).Value = ETeil5
.Cells(1, 36).Value = BruttoEinzel5
.Cells(1, 37).Value = Menge6
.Cells(1, 38).Value = Bez6
.Cells(1, 39).Value = ETeil6
.Cells(1, 40).Value = BruttoEinzel6
.Cells(1, 41).Value = Menge7
.Cells(1, 42).Value = Bez7
.Cells(1, 43).Value = ETeil7
.Cells(1, 44).Value = BruttoEinzel7
.Cells(1, 45).Value = Menge8
.Cells(1, 46).Value = Bez8
.Cells(1, 47).Value = ETeil8
.Cells(1, 48).Value = BruttoEinzel8
.Cells(1, 49).Value = Menge9
.Cells(1, 50).Value = Bez9
.Cells(1, 51).Value = ETeil9
.Cells(1, 52).Value = BruttoEinzel9
.Cells(1, 53).Value = Menge10
.Cells(1, 54).Value = Bez10
.Cells(1, 55).Value = ETeil10
.Cells(1, 56).Value = BruttoEinzel10
.Cells(1, 57).Value = Menge11
.Cells(1, 58).Value = Bez11
.Cells(1, 59).Value = ETeil11
.Cells(1, 60).Value = BruttoEinzel11
.Cells(1, 61).Value = Menge12
.Cells(1, 62).Value = Bez12
.Cells(1, 63).Value = ETeil12
.Cells(1, 64).Value = BruttoEinzel12
.Cells(1, 65).Value = Menge13
.Cells(1, 66).Value = Bez13
.Cells(1, 67).Value = ETeil13
.Cells(1, 68).Value = BruttoEinzel13
.Cells(1, 69).Value = Menge14
.Cells(1, 70).Value = Bez14
.Cells(1, 71).Value = ETeil14
.Cells(1, 72).Value = BruttoEinzel14
.Cells(1, 73).Value = Menge15
.Cells(1, 74).Value = Bez15
.Cells(1, 75).Value = ETeil15
.Cells(1, 76).Value = BruttoEinzel15
.Cells(1, 77).Value = Menge16
.Cells(1, 78).Value = Bez16
.Cells(1, 79).Value = ETeil16
.Cells(1, 80).Value = BruttoEinzel16
.Cells(1, 81).Value = Menge17
.Cells(1, 82).Value = Bez17
.Cells(1, 83).Value = ETeil17
.Cells(1, 84).Value = BruttoEinzel17
.Cells(1, 85).Value = Menge18
.Cells(1, 86).Value = Bez18
.Cells(1, 87).Value = ETeil18
.Cells(1, 88).Value = BruttoEinzel18
.Cells(1, 89).Value = Menge19
.Cells(1, 90).Value = Bez19
.Cells(1, 91).Value = ETeil19
.Cells(1, 92).Value = BruttoEinzel19
.Cells(1, 93).Value = Menge20
.Cells(1, 94).Value = Bez20
.Cells(1, 95).Value = ETeil20
.Cells(1, 96).Value = BruttoEinzel20
.Cells(1, 97).Value = spe73
.Cells(1, 98).Value = spe74
.Cells(1, 99).Value = spe75
.Cells(1, 100).Value = spe76
.Cells(1, 101).Value = spe77
.Cells(1, 102).Value = spe78
.Cells(1, 103).Value = spe79
.Cells(1, 104).Value = spe80
.Cells(1, 105).Value = spe81
.Cells(1, 106).Value = spe82
.Cells(1, 107).Value = spe92
.Cells(1, 108).Value = spe93
.Cells(1, 109).Value = spe94
.Cells(1, 110).Value = brutto
.Cells(1, 111).Value = stat
.Cells(1, 118).Value = JaNein
.Cells(1, 119).Value = Lagerplatz
.Cells(1, 120).Value = Leihgerät
Application.Goto .Cells(1, 1)
End With
End With
weiter:
Application.EnableEvents = False
ActiveCell.Select
ActiveCell = spe8
Selection.Offset(0, 1) = RechnungsNr
Selection.Offset(0, 2) = KundenNr
Selection.Offset(0, 3) = Geraetenummer
Selection.Offset(0, 4) = ExterneNummer
Selection.Offset(0, 5) = AuftragsDatum
Selection.Offset(0, 6) = RechnungsDatum
Selection.Offset(0, 7) = ReparaturStatus
Selection.Offset(0, 8) = spe3
Selection.Offset(0, 9) = GeraeteZustand
Selection.Offset(0, 10) = zubehoer
Selection.Offset(0, 11) = Freigabe
Selection.Offset(0, 12) = KvaErstellen
Selection.Offset(0, 13) = BezogeneTassen
Selection.Offset(0, 14) = GeraeteFehler1
Selection.Offset(0, 15) = GeraeteFehler2
Selection.Offset(0, 16) = Datum
Selection.Offset(0, 17) = Menge1
Selection.Offset(0, 18) = Bez1
Selection.Offset(0, 19) = ETeil1
Selection.Offset(0, 20) = BruttoEinzel1
Selection.Offset(0, 21) = Menge2
Selection.Offset(0, 22) = Bez2
Selection.Offset(0, 23) = Eteil2
Selection.Offset(0, 24) = BruttoEinzel2
Selection.Offset(0, 25) = Menge3
Selection.Offset(0, 26) = Bez3
Selection.Offset(0, 27) = Eteil3
Selection.Offset(0, 28) = BruttoEinzel3
Selection.Offset(0, 29) = Menge4
Selection.Offset(0, 30) = Bez4
Selection.Offset(0, 31) = ETeil4
Selection.Offset(0, 32) = BruttoEinzel4
Selection.Offset(0, 33) = Menge5
Selection.Offset(0, 34) = Bez5
Selection.Offset(0, 35) = ETeil5
Selection.Offset(0, 36) = BruttoEinzel5
Selection.Offset(0, 37) = Menge6
Selection.Offset(0, 38) = Bez6
Selection.Offset(0, 39) = ETeil6
Selection.Offset(0, 40) = BruttoEinzel6
Selection.Offset(0, 41) = Menge7
Selection.Offset(0, 42) = Bez7
Selection.Offset(0, 43) = ETeil7
Selection.Offset(0, 44) = BruttoEinzel7
Selection.Offset(0, 45) = Menge8
Selection.Offset(0, 46) = Bez8
Selection.Offset(0, 47) = ETeil8
Selection.Offset(0, 48) = BruttoEinzel8
Selection.Offset(0, 49) = Menge9
Selection.Offset(0, 50) = Bez9
Selection.Offset(0, 51) = ETeil9
Selection.Offset(0, 52) = BruttoEinzel9
Selection.Offset(0, 53) = Menge10
Selection.Offset(0, 54) = Bez10
Selection.Offset(0, 55) = ETeil10
Selection.Offset(0, 56) = BruttoEinzel10
Selection.Offset(0, 57) = Menge11
Selection.Offset(0, 58) = Bez11
Selection.Offset(0, 59) = ETeil11
Selection.Offset(0, 60) = BruttoEinzel11
Selection.Offset(0, 61) = Menge12
Selection.Offset(0, 62) = Bez12
Selection.Offset(0, 63) = ETeil12
Selection.Offset(0, 64) = BruttoEinzel12
Selection.Offset(0, 65) = Menge13
Selection.Offset(0, 66) = Bez13
Selection.Offset(0, 67) = ETeil13
Selection.Offset(0, 68) = BruttoEinzel13
Selection.Offset(0, 69) = Menge14
Selection.Offset(0, 70) = Bez14
Selection.Offset(0, 71) = ETeil14
Selection.Offset(0, 72) = BruttoEinzel14
Selection.Offset(0, 73) = Menge15
Selection.Offset(0, 74) = Bez15
Selection.Offset(0, 75) = ETeil15
Selection.Offset(0, 76) = BruttoEinzel15
Selection.Offset(0, 77) = Menge16
Selection.Offset(0, 78) = Bez16
Selection.Offset(0, 79) = ETeil16
Selection.Offset(0, 80) = BruttoEinzel16
Selection.Offset(0, 81) = Menge17
Selection.Offset(0, 82) = Bez17
Selection.Offset(0, 83) = ETeil17
Selection.Offset(0, 84) = BruttoEinzel17
Selection.Offset(0, 85) = Menge18
Selection.Offset(0, 86) = Bez18
Selection.Offset(0, 87) = ETeil18
Selection.Offset(0, 88) = BruttoEinzel18
Selection.Offset(0, 89) = Menge19
Selection.Offset(0, 90) = Bez19
Selection.Offset(0, 91) = ETeil19
Selection.Offset(0, 92) = BruttoEinzel19
Selection.Offset(0, 93) = Menge20
Selection.Offset(0, 94) = Bez20
Selection.Offset(0, 95) = ETeil20
Selection.Offset(0, 96) = BruttoEinzel20
Selection.Offset(0, 97) = spe73
Selection.Offset(0, 98) = spe74
Selection.Offset(0, 99) = spe75
Selection.Offset(0, 100) = spe76
Selection.Offset(0, 101) = spe77
Selection.Offset(0, 102) = spe78
Selection.Offset(0, 103) = spe79
Selection.Offset(0, 104) = spe80
Selection.Offset(0, 105) = spe81
Selection.Offset(0, 106) = spe82
Selection.Offset(0, 107) = spe92
Selection.Offset(0, 108) = spe93
Selection.Offset(0, 109) = spe94
Selection.Offset(0, 110) = brutto
Selection.Offset(0, 111) = stat
Selection.Offset(0, 118) = JaNein
Selection.Offset(0, 119) = Lagerplatz
Selection.Offset(0, 120) = Leihgerät
Application.EnableEvents = True
Windows("Erfassung.xls").Activate
Sheets("Eingabe Endkunde").Select
If Range("Extern") > 1 Then
Call Extern_speichern
End If
If Range("spe27") > "" Or Range("spe28") > "" Or Range("spe29") > "" Or Range("spe30") > "" _
Or Range("spe31") > "" Or Range("spe32") > "" Then
Call Extern_speichern
End If
Call Kunde_speichern
Range("PLZ_wahl") = 3
Range("ORT_wahl") = 3
Application.Goto Reference:="spe8"
Application.Calculation = xlCalculationAutomatic
'Vor dem Speichern der 4 Dateien alles neu berechnen
Application.Calculate
wkbAuftrag.Save
wkbKunden.Save
wkbGeraete.Save
wkbLager.Save
'Textdatei zur Markierung des Speichervorgangs wieder löschen
If Dir(strDatei) "" Then VBA.Kill strDatei
Else
intFF = FreeFile
Open strDatei For Input As #intFF
strMsg = ""
Do Until EOF(intFF)
Line Input #intFF, strText
strMsg = strMsg & vbLf & strText
Loop
Close #intFF
'Startdatum/-Zeit des letzten Speichervorgangs aus Text auslesen
varStartSpeichern = Right(strMsg, 19)
varStartSpeichern = CDate(varStartSpeichern)
'Nach maximal 2 Minuten kann die Markierungsdatei gelöscht und der Speichervorgang _
erneut gestartet werden
If Now - varStartSpeichern > TimeSerial(Hour:=0, Minute:=2, Second:=0) Then
If MsgBox(strMsg & Chr(13) _
& "Der Speichervorgang beim User liegt schon etwas zurück." & vbLf _
& "Info-Datei löschen und Speichervorgang erneut starten?", _
vbOKCancel + vbQuestion, _
"Hinweis:") = vbOK Then
VBA.Kill strDatei
GoTo ReStart:
End If
Else
MsgBox strMsg & Chr(13) _
& "Bitte warten Sie bis das Makro des anderen Users die Dateien wieder zum " _
& "Speichern freigegeben hat!" & vbLf & vbLf _
& "Starten Sie dann den Speichervorgang erneut.", _
vbOKOnly + vbInformation, _
"Hinweis:"
GoTo fehler
End If
End If
fehler:
With Err
Select Case .Number
Case 0 'alles in Ordnung
Case 9
MsgBox "Eine der Datei ist nicht geöffnet!"
Case Else
MsgBox "fehler-Nr.: " & .Number & vbLf & .Description
Close intFF
End Select
End With
'Makrobremsen zurücksetzen
With Application
.Calculation = StatusCalc
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub