AW: Button kann nur betätigt werden wenn ausgefüllt
05.02.2016 09:53:36
Rene
Habe ich den Code richtig eingefügt?
Private Sub AbschliessenButton_Click()
Dim i As Integer, bolOK As Integer
bolOK = True
For i = 4 To 12 Step 2
bolOK = bolOK And Len(Cells(i, 2))
Next
For i = 8 To 12 Step 2
bolOK = bolOK And Len(Cells(i, 8))
Next
If bolOK Then Call DasMakro
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If IsEmpty(Range("B4")) Then Cancel = True 'Mussfelder können nur ausgefüllt werden wenn die _
Felder die angegeben sind auch ausgeüllt sind
If IsEmpty(Range("B6")) Then Cancel = True
If IsEmpty(Range("B8")) Then Cancel = True
If IsEmpty(Range("B10")) Then Cancel = True
If IsEmpty(Range("B12")) Then Cancel = True
If IsEmpty(Range("H8")) Then Cancel = True
If IsEmpty(Range("H12")) Then Cancel = True
If IsEmpty(Range("H14")) Then Cancel = True
End Sub
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
If Not ActiveWB.Worksheets(2).Range("E37").Value = "" Then 'PO- _
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("E38").Value = "" Then 'PK- _
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
ActiveWorkbook.Save
ActiveWindow.Close
Dim strText As String
strText = "Die Daten wurden ausgelesen"
MsgBox strText
End Sub