Option Explicit
' Modul
' definieren der Objektvariable
Global DB As Database
Global RS As Recordset
Global crs As RecordsetPublic Sub main()
UserForm2.Show
End Sub
Public Sub proDBOpen()
Dim tabelle
' Initialisieren
Set DB = OpenDatabase("c:\db\nordwind.mdb", True, True)
UserForm2.Label1.Caption = DB.Name
Set RS = DB.OpenRecordset("artikel", dbOpenSnapshot, dbReadOnly)
'dbopentable zur bearbeitung, da funktioniert aber rs.absoluteposition nicht !!
RS.MoveLast
RS.MoveFirst
Set crs = DB.OpenRecordset("select count(*) from artikel") 'ausgabe in userform
' muss nicht sein - rs.recordcount !!
For Each tabelle In DB.TableDefs
UserForm2.lsttab.AddItem (tabelle.Name)
Next
End Sub
'ab hier in userform
Public Sub proDBClose()
RS.Close
DB.Close
End Sub
Private Sub cmdOK_Click()
Dim feld As Field
ListBox1.Clear
ListBox1.ColumnWidths = ""
'ListBox1.AddItem (feld.Value)
If lsttab.Text <> "" Then 'ansonsten tabelle artikel aus sub dbopen
Set RS = DB.OpenRecordset(lsttab.Text, dbOpenSnapshot, dbReadOnly)
End If
RS.MoveLast ' sonst bringt rs.recordcount 1
RS.MoveFirst
' Dim arrTabelle(1 To 10, 1 To 10) hier nicht, da variable Array-Zahl
ReDim arrTabelle(1 To RS.Fields.Count, 1 To RS.RecordCount)
UserForm2.ListBox1.ColumnCount = RS.Fields.Count
For Each feld In RS.Fields ' Spaltengrösse der Listbox einstellen
If feld.Type = Date Then
FeldGroesse = 5 * feld.Size + 25 ' summand für rand, bei datum zzgl
Else ' Platz fuer Punkte
FeldGroesse = 5 * feld.Size + 15 ' Feldtyp Beschreibung DB-Size = 0!!
End If ' da Länge dieses Typ's variabel ist
If ListBox1.ColumnWidths = "" Then ' erste Groesse ohne Semikolon
ListBox1.ColumnWidths = FeldGroesse
Else
ListBox1.ColumnWidths = ListBox1.ColumnWidths & ";" & FeldGroesse
End If
Next
Dim intRow As Integer, intCol As Integer
For intRow = 1 To RS.RecordCount ' array füllen / Zeilen
intCol = 0 ' muss für jede neue Zeile auf null gesetzt werden
For Each feld In RS.Fields ' array füllen / Spalten
intCol = intCol + 1
arrTabelle(intCol, intRow) = feld
Next
RS.MoveNext
Next intRow
ListBox1.Column = arrTabelle ' Listbox füllen
RS.MoveFirst ' sonst klappt weiter / zurueck nicht
ListBox1.Selected(0) = True
counter = "Datensatz: 1 von: " & RS.RecordCount
End Sub
Private Sub cmdEnde_Click()
RS.MoveLast
counter = "Datensatz: " & RS.AbsolutePosition + 1 & " von: " & RS.RecordCount
ListBox1.Selected(RS.AbsolutePosition) = True
End Sub
Private Sub cmdWeiter_Click()
'vor
If Not RS.EOF Then
RS.MoveNext
If RS.EOF Then
RS.MovePrevious
MsgBox "Ende erreicht", vbCritical
End If
' absoluteposition + 1, da mit 0 beginnend!
counter = "Datensatz: " & RS.AbsolutePosition + 1 & " von: " & RS.RecordCount
ListBox1.Selected(RS.AbsolutePosition) = True
End If
Exit Sub
End Sub
Private Sub cmdAnfang_Click()
RS.MoveFirst
counter = "Datensatz: " & RS.AbsolutePosition + 1 & " von: " & RS.RecordCount
ListBox1.Selected(RS.AbsolutePosition) = True
End Sub
Private Sub cmdZurueck_Click()
'zurück
If Not RS.BOF Then
RS.MovePrevious
If RS.BOF Then
RS.MoveNext
MsgBox "Anfang erreicht", vbCritical
End If
' absoluteposition + 1, da mit 0 beginnend!
counter = "Datensatz: " & RS.AbsolutePosition + 1 & " von: " & RS.RecordCount
ListBox1.Selected(RS.AbsolutePosition) = True
End If
End Sub
Private Sub cmdUndTschuess_Click()
Unload Me
End Sub
Private Sub lstTab_click()
Dim feld As Field
lstfeld.Clear
For Each feld In DB.TableDefs(lsttab.List(lsttab.ListIndex)).Fields
lstfeld.AddItem (feld.Name) & " (" & feld.Size & ")"
Next
End Sub
Private Sub UserForm_Initialize()
Dim tabelle
proDBOpen
End Sub
Private Sub UserForm_Terminate()
proDBClose
End Sub