AW: Daten in Userform
14.02.2006 18:36:52
Uwe
Hallo Peter,
sorrry bin leider nicht so fit damit und versuche mich da halt durchzuwurschteln.
also in der Maske sind alles Textboxen.
ich schicke hier nochmal meinen gesamten code .
ich glaube der Aufwand ist so das ich lieber die vorhandene Maske nutzen muß.
Gruß Uwe
Dim ScrollSaved As Integer 'Vorherige Einstellung für Bildlaufleiste
Dim datensatzanzahl% 'enthält die Anzahl der Datensätze
Dim aktiverdatensatz% 'enthält die Nummer des aktuell angezeigten Datensatzes
Dim geändert ', Zähler'gibt an, ob Datensatz vom Anwender verändert wurde
Dim tbl As Object
Dim dbblatt As Object 'verweist auf Tabellenblatt mit Datenbank
Dim dbzelle As Object 'verweist auf eine beliebige Zelle in der Datenbank
Dim linksoben As Object 'verweist auf erste Datenzelle (links oben) der Datenbank
Dim Zä As Object, i%
Dim änderungen 'gibt an, wieviele Datensätze seit dem letzen Speichern verändert wurden
Const änderungenMax = 1 'gibt an, nach wievielen geänderten Datensätzen eine Aufforderung zum
'Konstanten für den Zugriff auf die Datenbanktabelle
Const dbName = 1, dbVorname = 2, dbStraße = 3, dbPLZ = 4, dbOrt = 5
Const dbtel = 6, dbEmail = 7, dbpersonen = 8, dbankunft = 9, dbabreise = 10
Const dbtage = 11, dbanfragedatum = 12, dbzahlungsziel = 13, dbanzahlung = 14, dbaufbettung = 15
Const dbgesamtbetrag = 16, dbrestbetrag = 17, dbsonst = 18
Private Sub cmdDialogAufruf_Click()
DBMaske.Show
End Sub
Private Sub ButtonNeu_Click()
If geändert Then DatensatzSpeichern aktiverdatensatz
Bildlauf = datensatzanzahl + 1
aktiverdatensatz = datensatzanzahl + 1
DatensatzInMaskeÜbertragen aktiverdatensatz
Focus = "tname"
End Sub
Private Sub ButtonOK_Click()
Dim ergebnis%
If geändert Then Exit Sub
geändert = True
If geändert Then
ergebnis = MsgBox("Soll der aktuelle Datensatz gespeichert werden?", vbYesNo)
If ergebnis = vbYes Then DatensatzSpeichern aktiverdatensatz
End If
End Sub
Private Sub CommandButton3_Click()
If geändert Then DatensatzSpeichern aktiverdatensatz
Bildlauf = datensatzanzahl + 1
aktiverdatensatz = datensatzanzahl + 1
DatensatzInMaskeÜbertragen aktiverdatensatz
Focus = "tName"
End Sub
Private Sub CommandButton4_Click()
Unload DBMaske
End Sub
Private Sub ScrollBar1_Change()
Set Bildlauf = ScrollBar1
With ActiveDialog
' seitenweise Bewegung durch Bildlaufleiste
Bildlauf.Max = datensatzanzahl + 1
If datensatzanzahl / 10 > 1 Then
Bildlauf.LargeChange = datensatzanzahl / 10
Else
Bildlauf.LargeChange = 1
End If
End With
With ActiveDialog
' bisherigen Datensatz speichern
If geändert Then DatensatzSpeichern aktiverdatensatz
' wenn alle Datensätze angezeigt werden soll, kann einfach
' der angegebene Datensatz angezeigt werden
If geändert Then
aktiverdatensatz = Bildlauf
Else
' sonst muß nach einem SICHTBAREN Datensatz gesucht werden
If Bildlauf > aktiverdatensatz Then
gefunden = False
'nächsten sichtbaren Datensatz unten suchen
'zuerst Datensatz unterhalb der Bildlauf-Position suchen
For i = Bildlauf To datensatzanzahl
If linksoben.Cells(i, 1).EntireRow.Hidden = False Then
aktiverdatensatz = i: gefunden = True: Exit For
End If
Next i
' falls nicht erfolgreich: Datensatz zwischen aktueller Position und
' Bildlauf suchen
If Not gefunden Then
For i = Bildlauf To aktiverdatensatz + 1 Step -1
If linksoben.Cells(i, 1).EntireRow.Hidden = False Then
aktiverdatensatz = i: gefunden = True: Exit For
End If
Next i
End If
' falls noch immer erfolglos: neuen (leeren) Datensatz anzeigen
If gefunden = False Then aktiverdatensatz = datensatzanzahl + 1
Else
'nächsten sichtbaren Datensatz oben suchen
' zuerst oberhalb der Bildlauf-Position
For i = Bildlauf To 1 Step -1
If linksoben.Cells(i, 1).EntireRow.Hidden = False Then
aktiverdatensatz = i: gefunden = True: Exit For
End If
Next i
' falls nicht erfolgreich: zwischen aktueller Position und Bildlauf suchen
If Not gefunden Then
For i = Bildlauf To aktiverdatensatz
If linksoben.Cells(i, 1).EntireRow.Hidden = False Then
aktiverdatensatz = i: Exit For
End If
Next i
End If
End If
Bildlauf = aktiverdatensatz
End If
DatensatzInMaskeÜbertragen aktiverdatensatz
Focus = "Text1"
End With
End Sub
Private Sub UserForm_Initialize()
Dim ScrollSaved As Integer
Sheets("Buchung").Select
Range("A2").Select
ScrollBar1.Min = 1
ScrollBar1.Max = datensatzanzahl + 1
ScrollBar1.Value = 1
End Sub
Private Sub UserForm_Activate()
Set dbzelle = ActiveCell
Set Zä = dbzelle.CurrentRegion
datensatzanzahl = Zä.Rows.Count - 1
aktiverdatensatz = 1
geändert = False
änderungen = 0
Set linksoben = Zä.Cells(2, 1)
Set Bildlauf = ScrollBar1
With ActiveDialog
' seitenweise Bewegung durch Bildlaufleiste
Bildlauf.Max = datensatzanzahl + 1
If datensatzanzahl / 10 > 1 Then
Bildlauf.LargeChange = datensatzanzahl / 10
Else
Bildlauf.LargeChange = 1
End If
End With
DatensatzInMaskeÜbertragen aktiverdatensatz
End Sub
' überträgt einen Datensatz aus der Tabelle in die Maske
Sub DatensatzInMaskeÜbertragen(n%)
With ActiveDialog
tname.Text = linksoben.Cells(n, dbName)
tvorname.Text = linksoben.Cells(n, dbVorname)
tstraße.Text = linksoben.Cells(n, dbStraße)
tplz.Text = linksoben.Cells(n, dbPLZ)
tort.Text = linksoben.Cells(n, dbOrt)
ttel.Text = linksoben.Cells(n, dbtel)
temail.Text = linksoben.Cells(n, dbEmail)
tpersonen.Text = linksoben.Cells(n, dbpersonen)
tankunft.Text = linksoben.Cells(n, dbankunft)
tabreise.Text = linksoben.Cells(n, dbabreise)
ttage.Text = linksoben.Cells(n, dbtage)
tanfragedatum.Text = linksoben.Cells(n, dbanfragedatum)
tzahlungsziel.Text = linksoben.Cells(n, dbzahlungsziel)
tanzahlung.Text = linksoben.Cells(n, dbanzahlung)
taufbettung.Text = linksoben.Cells(n, dbaufbettung)
tgesamtbetrag.Text = linksoben.Cells(n, dbgesamtbetrag)
trestbetrag.Text = linksoben.Cells(n, dbrestbetrag)
tsonst.Text = linksoben.Cells(n, dbsonst)
geändert = False
Bildlauf = n
' Infotext in der Maske: »Datensatz n1 von n2«
If n
LabelDatensatz.Text = "Datensatz " & n & " von " & datensatzanzahl
Else
LabelDatensatz.Text = "neuer Datensatz"
End If
Set Bildlauf = ScrollBar1
Bildlauf.Max = datensatzanzahl + 1
End With
End Sub
' überträgt Datensatz von der Maske in die Tabelle
Sub DatensatzSpeichern(n%)
Dim X
Dim dbblatt As Object
Set Bildlauf = ScrollBar1
With ActiveDialog
'zur Geschwindigkeitsoptimierung
Application.ScreenUpdating = False
Application.Calculation = xlManual
If n = datensatzanzahl + 1 Then
'es handelt sich um einen neuen Datensatz: Formeln und Formatierungsdaten
' vom ersten Datensatz übernehmen
linksoben.Range(Cells(n, dbName), Cells(n, dbsonst)).Copy
' Anzahl der Datensätze vergrößern
datensatzanzahl = datensatzanzahl + 1
Bildlauf.Max = datensatzanzahl + 1
End If
' Daten übertragen
Dim Ankunft As Date
linksoben.Cells(n, dbName) = tname.Text
linksoben.Cells(n, dbVorname) = tvorname.Text
linksoben.Cells(n, dbStraße) = tstraße.Text
linksoben.Cells(n, dbPLZ) = tplz.Text
linksoben.Cells(n, dbOrt) = tort.Text
linksoben.Cells(n, dbtel) = ttel.Text
linksoben.Cells(n, dbEmail) = temail.Text
linksoben.Cells(n, dbpersonen) = tpersonen.Text
linksoben.Cells(n, dbankunft) = tankunft.Text
linksoben.Cells(n, dbabreise) = tabreise.Text
linksoben.Cells(n, dbtage) = ttage.Text
linksoben.Cells(n, dbanfragedatum) = tanfragedatum.Text
linksoben.Cells(n, dbzahlungsziel) = tzahlungsziel.Text
linksoben.Cells(n, dbanzahlung) = tanzahlung.Text
linksoben.Cells(n, dbaufbettung) = taufbettung.Text
linksoben.Cells(n, dbgesamtbetrag) = tgesamtbetrag.Text
linksoben.Cells(n, dbrestbetrag) = trestbetrag.Text
linksoben.Cells(n, dbsonst) = tsonst.Text
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End With
' nach änderungenMax veränderten Datensätzen zum Speichern auffordern
änderungen = änderungen + 1
End Sub
Private Sub CommandButton2_Click()
Dim ergebnis%
If geändert Then Exit Sub
geändert = True
If geändert Then
ergebnis = MsgBox("Soll der aktuelle Datensatz gespeichert werden?", vbYesNo)
If ergebnis = vbYes Then DatensatzSpeichern aktiverdatensatz
End If
End Sub