AW: Zeile ausschneiden wenn...
12.06.2020 10:17:57
Haller
mit dem von dir umgeschriebenen Code funktionieren nicht mehr alle meine befehle.
Mein Code sieht nun wie folgt aus
Option Explicit
Private Sub CommandButton1_Click()
Dim last As Integer
Dim wksAreal As Worksheet, wksFehler As Worksheet, aktSheet As Worksheet
Dim cntrl As MSForms.Control
Set wksAreal = Worksheets("Auf Areal")
Set wksFehler = Worksheets("Fehler")
Set aktSheet = Worksheets("Auf Areal")
'Rückfrage wenn Textbox leer
If TextBox_Datum_E = "" Then
MsgBox ("Bitte Datum eintragen")
Exit Sub
End If
If TextBox_Zeit_E = "" Then
MsgBox ("Bitte Zeit eintragen")
Exit Sub
End If
If TextBox_Wächter_E = "" Then
MsgBox ("Bitte Kurzzeichen eintragen")
Exit Sub
End If
If TextBox_Name = "" Then
MsgBox ("Bitte Name vom Fahrer eintragen")
Exit Sub
End If
If TextBoxFirma = "" Then
MsgBox ("Bitte Firma eintragen")
Exit Sub
End If
If TextBox_KZ1 = "" Then
MsgBox ("Bitte Kontrollschild eintragen")
Exit Sub
End If
If TextBox_SB = "" Then
MsgBox ("Bitte Kontaktperson eintragen")
Exit Sub
End If
If TextBox_Material = "" Then
MsgBox ("Bitte eintragen was Geliefert wurde oder -")
Exit Sub
End If
'Application.EnableEvents = True
'Application.ScreenUpdating = False
'Worksheets("Auf Areal").Activate
'solltest du hier nicht alle Textboxen auf leer prüfen wollen,
'dann muß du die einzeln abfragen und das zielblatt entsprechend setzen
For Each cntrl In Userfom.Controls ' durchsucht alle textboxen ob diese leer sind
If TypeOf ctnrl Is TextBox Then
If cntrl = "" Then 'wenn leer wir das Zielblatt geändert
Set aktSheet = wksFehler
End If
End If
Next
With aktSheet
last = .Cells(Rows.Count, 1).End(xlUp).Row + 1 'Erste Freie Zeile ausfindig machen
.Cells(last, 1).Value = TextBox_Wächter_E 'Wächter Eintritt
.Cells(last, 2).Value = TextBox_Datum_E 'Datum Eintritt
.Cells(last, 3).Value = TextBox_Zeit_E 'Zeit Eintritt
.Cells(last, 4).Value = TextBox_Name 'Name Fahrer
.Cells(last, 5).Value = TextBoxFirma 'Name Firma
.Cells(last, 6).Value = TextBox_KZ1 'Kontrollschild
'Kategorie
If OptionButton_LKW.Value = True Then .Cells(last, 7).Value = "LKW"
If OptionButton_PKW.Value = True Then .Cells(last, 7).Value = "PKW"
If OptionButton_Transporter.Value = True Then .Cells(last, 7).Value = "Transporter"
If OptionButton_Andere.Value = True Then .Cells(last, 7).Value = TextBox_Andere
.Cells(last, 8).Value = TextBox_SB 'Sachbearbeiter
.Cells(last, 9).Value = TextBox_Material 'Ware
.Cells(last, 10).Value = ListBox_Ladeort.Value 'Abladeort
'Ware Beschädigt
If OptionButton_Nein.Value = True Then .Cells(last, 11).Value = "Nein"
If OptionButton_Ja.Value = True Then .Cells(last, 11).Value = TextBox_Ware_beschädigt
.Cells(last, 12).Value = TextBox_Bemerkung 'Bemerkungen
'Gammaalarm
If OptionButton_Gamma_Nein.Value = True Then .Cells(last, 13).Value = "Nein"
If OptionButton_Gamma_Ja.Value = True Then .Cells(last, 13).Value = "Ja"
.Cells(last, 15).Value = TextBox_Bemerkungen_Gamma 'Bemerkungen Gammaalarm
.Cells(last, 16).Value = TextBox_Wächter_A 'Austritt Wächter
.Cells(last, 17).Value = TextBox_Datum_A 'Austritt Datum
.Cells(last, 18).Value = TextBox_Zeit_A 'Austritt Zeit
End With
'Liste leeren
TextBox_Wächter_E = ""
TextBox_Name = ""
TextBoxFirma = ""
TextBox_KZ1 = ""
TextBox_SB = ""
TextBox_Material = ""
TextBox_Bemerkung = ""
TextBox_Bemerkungen_Gamma = ""
TextBox_Wächter_A = ""
TextBox_Datum_A = ""
TextBox_Zeit_A = ""
Set wksAreal = Nothing
Set wksFehler = Nothing
Set aktSheet = Nothing
End Sub
Private Sub CommandButton2_Click()
Sheets("Auf Areal").Select
Unload UserForm3
Unload UserForm1
End Sub
Private Sub CommandButton3_Click()
ThisWorkbook.Save
Application.Quit
End Sub
Private Sub Frame5_Click()
End Sub
Private Sub TextBox_KZ1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim rngFind As Range
Dim rngFirst As Range
Set rngFind = Sheets("Erfassen").UsedRange.Find( _
what:=TextBox_KZ1.Text, _
lookat:=xlWhole, _
LookIn:=xlValues) 'In der Mappe "Erfassen" wird der Textinhalt von der Textbox KZ1 _
gesucht
If rngFind Is Nothing Then
Beep
MsgBox "Keine Gesuch gefunden!"
Exit Sub
End If
Set rngFirst = rngFind
Do
TextBoxFirma = "" 'Wenn etwas gefunden wird, zuerst Inhalt löschen. Damit ein doppelter _
eintrag verhindert wird
TextBox_SB = "" 'Wenn etwas gefunden wird, zuerst Inhalt löschen. Damit ein doppelter _
eintrag verhindert wird
TextBoxFirma.Text = TextBoxFirma.Text & rngFind.Offset(0, 1 - rngFind.Column).Text & _
vbLlf !!!!hier stockt es!!!!
TextBox_SB.Text = TextBox_SB.Text & rngFind.Offset(0, 14 - rngFind.Column) & vbLf
Set rngFind = Sheets("Erfassen").UsedRange.FindNext(rngFind)
Loop While Not rngFind Is Nothing And _
rngFind.Address rngFirst.Address
End Sub
Private Sub TextBox_Datum_A_Enter()
TextBox_Datum_A.Value = Date 'Automatisch beim Eintreten in Zelle Aktuelles Datum
End Sub
Private Sub TextBox_Wächter_A_Enter()
TextBox_Wächter_A.Value = Application.UserName 'Automatisch beim Eintreten in Zelle Name von _
angemeldetem Exceluser
End Sub
Private Sub TextBox_Wächter_E_Enter()
TextBox_Wächter_E.Value = Application.UserName 'Automatisch beim Eintreten in Zelle Name von _
angemeldetem Exceluser
End Sub
Private Sub TextBox_Zeit_A_Enter()
TextBox_Zeit_A.Value = Time 'Automatisch beim Eintreten in Zelle Aktuelle Zeit
End Sub
Private Sub UserForm_Initialize()
TextBox_Datum_E = Date
TextBox_Zeit_E = Time
'TextBox_Ware_beschädigt = "Wenn Ja ausfüllen"
'TextBox_Bemerkungen_Gamma = "Alarm beschreiben"
'TextBox_SU_MA = "Bei Alarm Ausfüllen"
OptionButton_Nein.Value = True 'Ware Beschädigt Standart Nein
OptionButton_Gamma_Nein.Value = True ' Gammaalarm Standart Nein
'Ab-/Aufladeort
With ListBox_Ladeort
.AddItem "Areal"
.AddItem "Vor der Schleuse"
.AddItem "In der Schleuse"
.AddItem "Instalationsplatz"
End With
ThisWorkbook.Save
End Sub