|
anbei ein CODE-Auszug (sry hatte ich vergessen)
zu Frage 1!!!!
Ablaufversuch?? (funktioniert jedoch nicht, er macht nur das Datensatz Tabellen eintragen - SUB DatensatzEintragen funktioniert nicht
Private Sub Datensaetze()
Do
DatensatzEintragen
DoEvents
DatensatzTabellen
Loop
End Sub
' ÈIntragen in Kundendatenbank
Private Sub DatensatzEintragen()
Dim rngExist As Range, lngLZ As Long
Dim i As Integer, rngID As Range
With ThisWorkbook.Worksheets("Kunde")
'Letzte freie Zeile in "Daten" ermitteln
lngLZ = .Cells(.Rows.Count, 1).End(xlUp).Row
'Prüfen ob datensatz bereits vorhanden
Set rngExist = .Range("A:A").Find(TextBox1, , xlValues, xlWhole)
If Not rngExist Is Nothing Then
If MsgBox("Datensatz existiert bereits. ÜBERSCHREIBEN?", _
vbYesNo, "Hinweis") = vbNo Then
Exit Sub
Else
lngLZ = rngExist.Row - 1
End If
End If
.Cells(lngLZ + 1, 2) = USERFORM.TextBox1
.Cells(lngLZ + 1, 3) = USERFORM.TextBox2
.Cells(lngLZ + 1, 4) = USERFORM.TextBox3
.Cells(lngLZ + 1, 5) = USERFORM.TextBox4
.Cells(lngLZ + 1, 6) = USERFORM.TextBox5
.Cells(lngLZ + 1, 7) = USERFORM.TextBox6
MsgBox "Datensatz wurde erfolgreich eingetragen.", , "Eintrag in Daten"
End With
End Sub
'Eintragen in Formulare
Private Sub DatensatzTabellen()
'erstes Formular
Sheets("ARBEITSMAPPE_1").Range("C" & 8).Value = USERFORM.TextBox1
Sheets("ARBEITSMAPPE_1").Range("D" & 12).Value = USERFORM.TextBox2
Sheets("ARBEITSMAPPE_1").Range("E" & 34).Value = USERFORM.TextBox3
Sheets("ARBEITSMAPPE_1").Range("F" & 35).Value = USERFORM.TextBox4
Sheets("ARBEITSMAPPE_1").Range("C" & 20).Value = USERFORM.TextBox5
Sheets("ARBEITSMAPPE_1").Range("C" & 2).Value = USERFORM.TextBox6
'zweites Formular
Sheets("ARBEITSMAPPE_2").Range("C" & 8).Value = USERFORM.TextBox1
Sheets("ARBEITSMAPPE_2").Range("D" & 12).Value = USERFORM.TextBox2
Sheets("ARBEITSMAPPE_2").Range("E" & 34).Value = USERFORM.TextBox3
Sheets("ARBEITSMAPPE_2").Range("F" & 35).Value = USERFORM.TextBox4
Sheets("ARBEITSMAPPE_2").Range("C" & 20).Value = USERFORM.TextBox5
Sheets("ARBEITSMAPPE_2").Range("C" & 2).Value = USERFORM.TextBox6
End Sub
|