|
Tipp 0278
|
Datensätze bearbeiten, suchen und drucken
|
|
|
Autor/Einsender: Datum: |
|
Dinko Hasanbasic 12.10.2002 |
|
Entwicklungsumgebung: |
|
VB 6 |
|
|
Diesen Tipp könnte man als Grundlage für eine eigene Adressdatenbank benutzen. Es können Einträge
hinzugefügt, gelöscht und gedruckt werden, eine Suchfunktion ist auch integriert. Das "Herz" des
Projekts ist die Klasse Adressbuch. In ihr befinden sich alle wichtigen Variablen,
Eigenschaften (Properties) und Routinen. Diesem Tipp ist auch eine Hilfe-Datei beigefügt, in der
nähere Erläuterungen zu finden sind.
|
|
Code im Codebereich des Klassenmoduls Adressbuch |
|
|
Option Explicit
Private mvarVorname As String
Private mvarNachname As String
Private mvarTelefon As String
Private mvarAdresse As String
Private mvarStadt As String
Private mvarLand As String
Private mvarEmail As String
Dim Ws As Workspace
Dim Db As Database
Dim Rs As Recordset
Dim Feld As Field
Public Enum adKategorie
adVorname = 0
adNachname = 1
adTelefon = 2
adAdresse = 3
adStadt = 4
adLand = 5
adEmail = 6
End Enum
Public Enum adBewegen
adVor = 0
adNach = 1
End Enum
Public Sub Init()
If Dir(App.Path & "\AdBuch.MDB") = "" Then NeueDatenbank
Set Ws = DBEngine.Workspaces(0)
Set Db = Ws.OpenDatabase((App.Path & "\AdBuch.MDB"))
Set Rs = Db.OpenRecordset("Adressen", dbOpenTable)
RefreshRs
End Sub
Public Sub NeueDatenbank()
Dim i As Integer
Dim Tb As TableDef
Dim RecS As Recordset
Dim Felder(6) As String
Felder(0) = "Vorname"
Felder(1) = "Nachname"
Felder(2) = "Telefon"
Felder(3) = "Adresse"
Felder(4) = "Stadt"
Felder(5) = "Land"
Felder(6) = "Email"
Set Ws = DBEngine.Workspaces(0)
Set Db = Ws.CreateDatabase(App.Path & "\AdBuch.MDB", _
dbLangGeneral, dbVersion30)
Set Tb = Db.CreateTableDef("Adressen")
For i = 0 To 6
Set Feld = Tb.CreateField(Felder(i), dbText, 200)
Tb.Fields.Append Feld
Next i
Db.TableDefs.Append Tb
Set Rs = Db.OpenRecordset("Adressen")
Rs.AddNew
For i = 0 To 6
Rs.Fields(i).Value = "Neu"
Next i
Rs.Update
UnInit
End Sub
Public Sub UnInit()
Db.Close
Set Feld = Nothing
Set Rs = Nothing
Set Db = Nothing
Set Ws = Nothing
End Sub
Public Sub Speichern()
Rs.AddNew
Rs.Fields(0).Value = Vorname
Rs.Fields(1).Value = Nachname
Rs.Fields(2).Value = Telefon
Rs.Fields(3).Value = Adresse
Rs.Fields(4).Value = Stadt
Rs.Fields(5).Value = Land
Rs.Fields(6).Value = Email
Rs.Update
Rs.Bookmark = Rs.LastModified
End Sub
Public Sub Bewegen(Richtung As adBewegen)
Select Case Richtung
Case adVor
Rs.MovePrevious
Case adNach
Rs.MoveNext
End Select
If Rs.EOF Then
MsgBox "Sie sind am Ende der Einträgeliste.", _
vbInformation + vbOKOnly, "Information"
Rs.MovePrevious
ElseIf Rs.BOF Then
Rs.MoveNext
MsgBox "Sie sind am Anfang der Einträgeliste.", _
vbInformation + vbOKOnly, "Information"
End If
RefreshRs
End Sub
Sub RefreshRs()
If Rs.RecordCount = 0 Then
MsgBox "Die Datenbank ist leer!", _
vbInformation + vbOKOnly, "Information"
frmMain.cmdAnsicht.Enabled = False
frmMain.cmdSuche.Enabled = False
frmMain.Show
frmMain.cmdNeu_Click
Exit Sub
End If
Vorname = Rs.Fields(0).Value
Nachname = Rs.Fields(1).Value
Telefon = Rs.Fields(2).Value
Adresse = Rs.Fields(3).Value
Stadt = Rs.Fields(4).Value
Land = Rs.Fields(5).Value
Email = Rs.Fields(6).Value
End Sub
Public Sub Löschen()
Rs.Delete
If Rs.RecordCount = 0 Then
MsgBox "Der Datenbank ist nun leer. " & vbCrLf & _
"Sie können jetzt nur noch neue Adressen eingeben.", _
vbInformation + vbOKOnly, "Information"
frmMain.cmdAnsicht.Enabled = False
frmMain.cmdSuche.Enabled = False
frmMain.cmdNeu_Click
Exit Sub
End If
Bewegen adVor
RefreshRs
End Sub
Public Function Suche(Kategorie As adKategorie, _
Begriff As String) As Boolean
Dim i As Integer
Rs.MoveFirst
For i = 0 To Rs.RecordCount - 1
If Rs.Fields(Kategorie).Value = Begriff Then
Suche = True
Exit For
End If
Rs.MoveNext
Next i
If Suche = True Then
MsgBox "Die Suche war erfolgreich!", _
vbInformation + vbOKOnly, "Gefunden"
RefreshRs
Else
MsgBox "Der Suchbegriff wurde nicht gefunden.", _
vbInformation + vbOKOnly, "Nicht gefunden"
Rs.MoveFirst
RefreshRs
Suche = False
End If
End Function
Public Property Let Email(ByVal vData As String)
mvarEmail = vData
End Property
Public Property Get Email() As String
Email = mvarEmail
End Property
Public Property Let Land(ByVal vData As String)
mvarLand = vData
End Property
Public Property Get Land() As String
Land = mvarLand
End Property
'...
'...
'...
Public Property Let Nachname(ByVal vData As String)
mvarNachname = vData
End Property
Public Property Get Nachname() As String
Nachname = mvarNachname
End Property
Public Property Let Vorname(ByVal vData As String)
mvarVorname = vData
End Property
Public Property Get Vorname() As String
Vorname = mvarVorname
End Property
|
|
|
Code im Codebereich der Form frmMain |
|
|
Option Explicit
Dim Adressen As New Adressbuch
Private Sub Form_Load()
Dim sngLeft As Single
Dim sngTop As Single
sngLeft = 120
sngTop = 1080
fraSuchen.Move sngLeft, sngTop
fraNeu.Move sngLeft, sngTop
fraAnsicht.Move sngLeft, sngTop
With Me
.Width = 4785
.Height = 5760
End With
With cmbK
.AddItem "Vorname"
.AddItem "Nachname"
.AddItem "Telefon"
.AddItem "Adresse"
.AddItem "Stadt"
.AddItem "Land"
.AddItem "Email"
.ListIndex = 0
End With
Adressen.Init
End Sub
Private Sub Form_Unload(Cancel As Integer)
Adressen.UnInit
End
End Sub
'----------- Frame "Ansicht der Adressen" -------------
Private Sub cmdAnsicht_Click()
fraNeu.Visible = False
fraAnsicht.Visible = True
fraSuchen.Visible = False
AdAnsicht
End Sub
Private Sub cmdVor_Click()
Adressen.Bewegen adVor
AdAnsicht
End Sub
Private Sub cmdNach_Click()
Adressen.Bewegen adNach
AdAnsicht
End Sub
Private Sub cmdL_Click()
Adressen.Löschen
AdAnsicht
End Sub
Private Sub cmdPrint_Click()
RTB.SelPrint Printer.hDC
End Sub
Private Sub AdAnsicht()
RTB.Text = Adressen.Vorname & " " & Adressen.Nachname & vbCrLf
RTB.Text = RTB.Text & vbCrLf
RTB.Text = RTB.Text & "Tel: " & Adressen.Telefon & vbCrLf
RTB.Text = RTB.Text & "Adresse: " & Adressen.Adresse & ", " & _
Adressen.Stadt & ", " & Adressen.Land & vbCrLf
RTB.Text = RTB.Text & vbCrLf
RTB.Text = RTB.Text & "Email: " & Adressen.Email
End Sub
'----------- Frame "Adresse suchen" -------------------
Private Sub cmdSuche_Click()
fraNeu.Visible = False
fraAnsicht.Visible = False
fraSuchen.Visible = True
cmbK.SetFocus
End Sub
Private Sub txtS_Change()
If Len(Trim(txtS.Text)) = 0 Then
cmdS.Enabled = False
Else
cmdS.Enabled = True
End If
End Sub
Private Sub cmdS_Click()
If Adressen.Suche(cmbK.ListIndex, txtS.Text) = False Then _
Exit Sub
AdAnsicht
cmdAnsicht_Click
End Sub
'----------- Frame "Neue Adresse" ---------------------
Sub cmdNeu_Click()
fraNeu.Visible = True
fraAnsicht.Visible = False
fraSuchen.Visible = False
txt(0).SetFocus
End Sub
Private Sub cmdOKN_Click()
Adressen.Vorname = txt(0).Text
Adressen.Nachname = txt(1).Text
Adressen.Telefon = txt(2).Text
Adressen.Adresse = txt(3).Text
Adressen.Stadt = txt(4).Text
Adressen.Land = txt(5).Text
Adressen.Email = txt(6).Text
Adressen.Speichern
cmdAnsicht.Enabled = True
cmdSuche.Enabled = True
cmdAnsicht_Click
End Sub
|
|
|
|
Um diesen Tipp ausführen zu können, muss die Microsoft DAO 3.x Object Library
als Verweis in das Projekt eingebunden werden.
|
|
|
|
Windows-Version |
95 |
|
|
98/SE |
|
|
ME |
|
|
NT |
|
|
2000 |
|
|
XP |
|
|
Vista |
|
|
Win
7 |
|
|
|
VB-Version |
VBA 5 |
|
|
VBA 6 |
|
|
VB 4/16 |
|
|
VB 4/32 |
|
|
VB 5 |
|
|
VB 6 |
|
|
|
|
Download (32,3 kB)
|
Downloads bisher: [ 4837 ]
|
|
|