Hallo Matthias,
ich will ja nichts anbieten sondern bitte um Hilfe für mein Programm.
Ich arbeite mit der Herber CD die ich seit über 10 Jahren habe und welche teilweise schon überholt ist.
Ich will mich nur nicht verrenne.
Z.B ein Code von mir:
Sub LF_Adresse_Speichern()
Dim strAltNeu As String
Set WkbD = Workbooks(sData)
Set WksLF = WkbD.Worksheets(LF)
On Error Resume Next
REM überprüfen ob alle Felder welche blau umrandet sind, ausgefüllt wurden
bytZaehler = 0
For Each Obj In frmStart.fraLFAdr.Controls
Select Case TypeName(Obj)
Case "TextBox", "ComboBox"
If Obj.BorderColor = 16711680 And Obj = "" Then
bytZaehler = bytZaehler + 1
End If
End Select
Next Obj
REM nicht ausgefüllt dann Meldung
If bytZaehler 0 Then
Mldg = MsgBox("Sie haben nicht alle Daten " _
& vbLf & "zum speichern " _
& vbLf & "eingetragen... " _
, vbOKOnly + vbCritical, "Fehler: Speichern Kundendaten")
frmStart.Repaint
GoTo 1
End If
REM jetzt suchen ob der LF schon vorhanden ist und damit überschrieben wird oder ob neu
On Error GoTo FEHLER
With WksLF
bytSpalte = .Rows(1).Find(what:="DB_LF_KDNR", LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows).Column
bytReihesuch = .Columns(bytSpalte).Find(what:=frmStart.lblLFNr.Caption, LookIn:= _
xlValues, lookat:=xlWhole).Row
End With
bytReihe = bytReihesuch
strAltNeu = "alt"
GoTo weiter01:
FEHLER:
bytReihe = ii + 1
strAltNeu = "neu"
weiter01:
REM hier suchen nach dem Titel und eintragen nur weil ich ständig neue Zeile hinzufüge
With WksLF
bytSpalte = .Rows(1).Find(what:="DB_LF_ID", LookIn:=xlValues, lookat:=xlWhole).Column
.Cells(bytReihe, bytSpalte) = bytReihe
bytSpalte = .Rows(1).Find(what:="DB_LF_KDNR", LookIn:=xlValues, lookat:=xlWhole).Column
.Cells(bytReihe, bytSpalte) = frmStart.lblLFNr.Caption
bytSpalte = .Rows(1).Find(what:="DB_LF_ANREDE", LookIn:=xlValues, lookat:=xlWhole). _
Column
.Cells(bytReihe, bytSpalte) = frmStart.cboLFAnrede.Value
bytSpalte = .Rows(1).Find(what:="DB_LF_NACHNAME", LookIn:=xlValues, lookat:=xlWhole). _
Column
.Cells(bytReihe, bytSpalte) = frmStart.txtLFNachname.Value
bytSpalte = .Rows(1).Find(what:="DB_LF_ZUSATZ", LookIn:=xlValues, lookat:=xlWhole). _
Column
.Cells(bytReihe, bytSpalte) = frmStart.txtLFZusatzName.Value
bytSpalte = .Rows(1).Find(what:="DB_LF_STRASSE", LookIn:=xlValues, lookat:=xlWhole). _
Column
.Cells(bytReihe, bytSpalte) = frmStart.txtLFStrasse.Value
bytSpalte = .Rows(1).Find(what:="DB_LF_PLZ", LookIn:=xlValues, lookat:=xlWhole).Column
.Cells(bytReihe, bytSpalte) = frmStart.txtLFPlz.Value
bytSpalte = .Rows(1).Find(what:="DB_LF_ORT", LookIn:=xlValues, lookat:=xlWhole).Column
.Cells(bytReihe, bytSpalte) = frmStart.txtLFOrt.Value
bytSpalte = .Rows(1).Find(what:="DB_LF_MOBIL", LookIn:=xlValues, lookat:=xlWhole). _
Column
.Cells(bytReihe, bytSpalte).NumberFormat = "@"
.Cells(bytReihe, bytSpalte) = frmStart.txtLFMobil.Value
bytSpalte = .Rows(1).Find(what:="DB_LF_TEL1", LookIn:=xlValues, lookat:=xlWhole).Column
.Cells(bytReihe, bytSpalte).NumberFormat = "@"
.Cells(bytReihe, bytSpalte) = frmStart.txtLFTel1.Value
bytSpalte = .Rows(1).Find(what:="DB_LF_TEL2", LookIn:=xlValues, lookat:=xlWhole).Column
.Cells(bytReihe, bytSpalte).NumberFormat = "@"
.Cells(bytReihe, bytSpalte) = frmStart.txtLFTel2.Value
bytSpalte = .Rows(1).Find(what:="DB_LF_FAX", LookIn:=xlValues, lookat:=xlWhole).Column
.Cells(bytReihe, bytSpalte).NumberFormat = "@"
.Cells(bytReihe, bytSpalte) = frmStart.txtLFFax.Value
bytSpalte = .Rows(1).Find(what:="DB_LF_MAIL", LookIn:=xlValues, lookat:=xlWhole).Column
.Cells(bytReihe, bytSpalte) = frmStart.txtLFMail.Value
bytSpalte = .Rows(1).Find(what:="DB_LF_HOME", LookIn:=xlValues, lookat:=xlWhole).Column
.Cells(bytReihe, bytSpalte) = frmStart.txtLFHome.Value
bytSpalte = .Rows(1).Find(what:="DB_LF_NOTIZ", LookIn:=xlValues, lookat:=xlWhole).Column
.Cells(bytReihe, bytSpalte) = frmStart.txtLFNotiz.Value
bytSpalte = .Rows(1).Find(what:="DB_LF_HSNR", LookIn:=xlValues, lookat:=xlWhole).Column
.Cells(bytReihe, bytSpalte) = frmStart.txtLFHNr.Value
bytSpalte = .Rows(1).Find(what:="DB_EIG_LF_KDNR", LookIn:=xlValues, lookat:=xlWhole). _
Column
.Cells(bytReihe, bytSpalte) = frmStart.txtLFEigeneKdnr.Value
bytSpalte = .Rows(1).Find(what:="DB_SP_LF_DATUM", LookIn:=xlValues, lookat:=xlWhole). _
Column
.Cells(bytReihe, bytSpalte) = Date
bytSpalte = .Rows(1).Find(what:="DB_SP_LF_ZEIT", LookIn:=xlValues, lookat:=xlWhole). _
Column
.Cells(bytReihe, bytSpalte) = Format(Now, "hh:mm")
.Columns.AutoFit
End With
REM Meldung ob neu oder alt
If strAltNeu = "neu" Then
Call LF_Zaehler_erhoehen
Mldg = MsgBox("Der Kunde " _
& vbLf & frmStart.txtLFNachname _
& vbLf & "wurde gespeichert... " _
, vbOKOnly + vbInformation, "Meldung: Lieferant gespeichert!")
Else
Mldg = MsgBox("Der Kunde " _
& vbLf & frmStart.txtLFNachname _
& vbLf & "wurde geändert und gespeichert... " _
, vbOKOnly + vbInformation, "Meldung: Lieferant gespeichert!")
End If
REM den Speicherstatus anzeigen
With frmStart
With .txtLFAdressdatengesp
.Value = "ja"
.ForeColor = 16777215 'weiss
.BackColor = 49152 'grün
End With
REM wenn Kunde gepeichert wurde dürfen die Button für Bank und Ansprechpartner betätigt weren
bolBankanlegen = True
bolAnspanlegen = True
.lblLFLetzteSpeicherungDatum.Caption = ""
.lblLFLetzteSpeicherungZeit.Caption = ""
.lblLFLetzteSpeicherung.Caption = ""
End With
REM die zusätzliche Arbeitsmappe speichern, extra Datei
Workbooks(sData).Save
1 End Sub
So in etwa zieht sich mein ganzes Programm hin.
Ich denke, dass ich irgendwo große Fehler habe, da dass Starten der UF schon ca. 6 sec. dauert.
Während das speichern nur 0,5 sec dauert.
Danke für Deine Anregungen und Zeit.
Gruß
Ludmila