UserForm (Löschen und Sortieren)
04.07.2005 21:21:31
Sebi
ich hab ne UserForm erstellt wo ich Daten in andere Spalten eintrage. Jetzt brächte ich noch einen Code wenn ich auf den Button Löschen drücke das sich die Daten autumatisch sortieren oder das die Daten eins nach oben rücken.
Bitte um hilfe !!!
Gruss Sebi
Option Explicit
Private Sub cmdOK_Click()
Dim Zeile As Integer
Dim Spalte As Integer
Zeile = 1 ' Startwert anpassen
Spalte = 5 ' Startwert anpassen
Do While Worksheets("Tel.Nr.").Cells(Zeile, Spalte) <> ""
Zeile = Zeile + 1
Loop
Cells(Zeile, Spalte) = frmAufn.nname.Value
Cells(Zeile, Spalte + 1) = frmAufn.vname.Value
Cells(Zeile, Spalte + 2) = frmAufn.telp.Value
Cells(Zeile, Spalte + 3) = frmAufn.telf.Value
Cells(Zeile, Spalte + 4) = frmAufn.handyp.Value
Cells(Zeile, Spalte + 5) = frmAufn.handyf.Value
Cells(Zeile, Spalte + 6) = frmAufn.fax.Value
Cells(Zeile, Spalte + 7) = frmAufn.email.Value
Cells(Zeile, Spalte + 8) = frmAufn.str.Value
Cells(Zeile, Spalte + 9) = frmAufn.wohn.Value
frmAufn.vname.Value = ""
frmAufn.nname.Value = ""
frmAufn.telp.Value = ""
frmAufn.telf.Value = ""
frmAufn.handyp.Value = ""
frmAufn.handyf.Value = ""
frmAufn.fax.Value = ""
frmAufn.email.Value = ""
frmAufn.str.Value = ""
frmAufn.wohn.Value = ""
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub txtArb_Change()
End Sub
Private Sub txtMon_Change()
End Sub
Private Sub txtStart_Change()
End Sub
Private Sub email_Change()
End Sub
Private Sub fax_Change()
End Sub
Private Sub handyf_Change()
End Sub
Private Sub handyp_Change()
End Sub
Private Sub nname_Change()
End Sub
'Code zum Scrollen
Private Sub ScrollBar1_Change()
Dim Spalte As Integer
Dim X As Long
Spalte = 5
X = Me.ScrollBar1.Value
If X = 1 Then
X = 2
End If
frmAufn.nname.Value = Cells(X, Spalte)
frmAufn.vname.Value = Cells(X, Spalte + 1)
frmAufn.telp.Value = Cells(X, Spalte + 2)
frmAufn.telf.Value = Cells(X, Spalte + 3)
frmAufn.handyp.Value = Cells(X, Spalte + 4)
frmAufn.handyf.Value = Cells(X, Spalte + 5)
frmAufn.fax.Value = Cells(X, Spalte + 6)
frmAufn.email.Value = Cells(X, Spalte + 7)
frmAufn.str.Value = Cells(X, Spalte + 8)
frmAufn.wohn.Value = Cells(X, Spalte + 9)
End Sub
' Code um die Scroll-Bar bezüglich der Datensatzanzahl anzupassen
Private Sub UserForm_Initialize()
ScrollBar1.Min = ActiveCell.CurrentRegion.Rows.Count
ScrollBar1.Max = 20
End Sub
Private Sub str_Change()
End Sub
Private Sub telf_Change()
End Sub
Private Sub telp_Change()
End Sub
Private Sub vname_Change()
End Sub
Private Sub wohn_Change()
End Sub