Liste speichern und schließen alles im Hintergrund
27.01.2016 10:28:40
Rene
ich habe eine Auslese, der ließt das Protokoll aus und ließt es in eine Liste, diese Liste soll er aber nach den auslesen, automatisch speichern und dann schließen.
ohne einen weiteren Button :) könnt ihr mir helfen?
Ich habe eine Idee aber diese funktioniert nicht.
Private Sub AbschliessenButton_Click()
Dim PfadA As String
Dim PfadF As String
'Hier werden die Pfade bestimmt an denen die Auswertungsdateien liegen. Werden diese _
Dateien dort nicht gefunden gibt es Fehlen
'Aktuell wird erwartet das die Auswertungsdateien im gleichen Ordner stecken ( _
ActiveWorkbook.Path)
PfadA = ActiveWorkbook.Path & "\Ergebnis_Zeitaufnahme_1.xlsx"
'Hiermit wird das Sub weiter unten aufgerufen, darin werden die Daten übertragen
Call MappeBeschreiben(PfadA, PfadF)
'Das Datum wurde bisher per formel eingetragen, nach Abschluss des Audits, darf dieses _
Datum nicht weiter aktualisiert werden
'Darum erst Formel löschen
Worksheets(2).Range("F4").Formula = ""
'Dann aktuelles Datum eintragen
Worksheets(2).Range("F4").Value = Date
'Abschließend muss verhindert werden, dass das gleiche Audit 2 mal in den Daten erfasst _
wird.
'Darum wird der Button deaktiviert
'AbschliessenButton.Enabled = False'
End Sub
Private Sub MappeBeschreiben(PfadA As String, PfadF As String)
'In diesem Sub werde ich mit 2 excel dateien gleichzeitig arbeiten, Der einfachheit halber _
bekommen sie kurze Namen
'WBA ist Das Archiv der A-Kollis
Dim WBA As Workbook
'ActiveWB ist die Datei Packstück_Audit
Dim ActiveWB As Workbook
'Außerdem benötige ich die erste freie Zeile in den archiven, um nichts zu überschreiben
Dim LetzteZeileA As Long
Dim LetzteZeileF As Long
Dim col As Integer
'Bildschirm wird vorerst nichtmehr aktualisiert (schneller, und man sieht die ganzen fenster _
nicht rumspringen)
Application.ScreenUpdating = False
'Oben habe ich 3 Dateien benannt, hier folgt die zuordnung:
'die momentan aktive Datei ist Packstückaudit
Set ActiveWB = ActiveWorkbook
'die beiden anderen werden erst geöffnet und dabei gleich zugewiesen
Set WBA = Workbooks.Open(PfadA)
'hier werden die letzten Zeilen gesucht, dabei orientiere ich mich an der 2. spalte, weil dort _
der Fehler-typ drinsteht.
'Diese Zelle kann unmöglich frei bleiben, weil mindestens i.O. drin steht
LetzteZeileA = WBA.Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
'A-Kolli-Daten befüllen
'Zuerst grundlegende Daten von einer Datei in die andere Übertragen
With WBA.Worksheets(1)
col = 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("B4").Value 'Laufende _
Nr.
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("B6").Value 'HU
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("B8").Value ' _
Bemerkungen
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("B10").Value 'Verweis _
Reklamation
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("B12").Value 'Folgecheck _
vom
col = col + 1
' .Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("B14").Value ' _
Frei 1
'col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("F4").Value 'Datum
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("H6").Value 'Fehler/ _
Ergebnis des Audits
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("H8").Value ' _
Konsolidierer
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("H12").Value 'Packsück
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("H14").Value 'Bereich
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("H54").Value 'Eintragung _
durch
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("B54").Value ' _
Zeitaufnehmer
'Hier werden die Ankreuzfelder übertragen, "WAHR" wenn fehler, "FALSCH" wenn kein Fehler
col = col + 1
If Not ActiveWB.Worksheets(2).Range("E17").Value = "" Then 'QV- Verpacker
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "WAHR"
Else
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "FALSCH"
End If
col = col + 1
If Not ActiveWB.Worksheets(2).Range("E18").Value = "" Then 'PT- Verpacker
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "WAHR"
Else
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "FALSCH"
End If
col = col + 1
If Not ActiveWB.Worksheets(2).Range("E19").Value = "" Then 'KV- Verpacker
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "WAHR"
Else
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "FALSCH"
End If
col = col + 1
If Not ActiveWB.Worksheets(2).Range("E20").Value = "" Then 'MRS- Verpacker
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "WAHR"
Else
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "FALSCH"
End If
col = col + 1
If Not ActiveWB.Worksheets(2).Range("E21").Value = "" Then 'ZA- Verpacker
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "WAHR"
Else
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "FALSCH"
End If
col = col + 1
'If Not ActiveWB.Worksheets(2).Range("E22").Value = "" Then 'Leer1
' WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "WAHR"
'Else
' WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "FALSCH"
'End If
'col = col + 1
'If Not ActiveWB.Worksheets(2).Range("E23").Value = "" Then 'Leer2
' WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "WAHR"
'Else
' WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "FALSCH"
'End If
' col = col + 1
If Not ActiveWB.Worksheets(2).Range("E32").Value = "" Then 'QV- _
Zeitaufnehmer
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "WAHR"
Else
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "FALSCH"
End If
col = col + 1
If Not ActiveWB.Worksheets(2).Range("E33").Value = "" Then 'PT- _
Zeitaufnehmer
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "WAHR"
Else
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "FALSCH"
End If
col = col + 1
If Not ActiveWB.Worksheets(2).Range("E34").Value = "" Then 'KV- _
Zeitaufnehmer
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "WAHR"
Else
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "FALSCH"
End If
col = col + 1
If Not ActiveWB.Worksheets(2).Range("E35").Value = "" Then 'MRS- _
Zeitaufnehmer
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "WAHR"
Else
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "FALSCH"
End If
col = col + 1
If Not ActiveWB.Worksheets(2).Range("E36").Value = "" Then 'ZA- _
Zeitaufnehmer
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "WAHR"
Else
WBA.Worksheets(1).Cells(LetzteZeileA, col).Value = "FALSCH"
End If
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("A48").Value ' _
Fehlercode1
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("C48").Value 'Bemerkung1
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("A49").Value ' _
Fehlercode2
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("C49").Value 'Bemerkung2
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("A50").Value ' _
Fehlercode3
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("C50").Value 'Bemerkung3
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("A51").Value ' _
Fehlercode4
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("C51").Value 'Bemerkung4
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("A52").Value ' _
Fehlercode5
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("C52").Value 'Bemerkung5
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("K6").Value 'Jahr
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("K8").Value 'Monat
col = col + 1
.Cells(LetzteZeileA, col).Value = ActiveWB.Worksheets(2).Range("K10").Value ' _
Kalenderwoche
End With
End Sub