i have a problem with an db&vba which was written by someone else, but
i have to work on it now. there is a form opened by a vba and instead
of the form there is only a white/grey form without anything on it.
if i start the form itself it says "cannot jump to this data record"
and if i debugg it stops at the marked line. the guy who wrote it told
me it was working...
Option Compare Database
Option Explicit
Private Sub DU_DOWN_Click()
Me!DU2 = Me!DU1
Me!DU1 = Me!DU
Me!DU = ""
End Sub
Private Sub ErgebnisListe_AfterUpdate()
Dim STR As String
STR = "SELECT Person.PN, Person.TITL, Person.NN, Person.VN,
Person.MW, Person.BER, Person.GEB, Person.STR, Person.PLZ,
Person.[EIN], Person.LG, Person.VAZ, Person.CODE1, Person.CODE2,
Person.MBI, Person.STD, Person.REF, Person.VERW, Person.DNGRP1,
Person.DNGRP2, Person.URLAN, Person.URLAQ, Person.ABW, Person.ABWV,
Person.ABWB, Ort.WOO, DU.DU, DU.DU1, DU.DU2 FROM Ort RIGHT JOIN (DU
RIGHT JOIN Person ON DU.PN=Person.PN) ON Ort.PLZ=Person.PLZ " _
& "WHERE Person.PN="
STR = STR + Me!ErgebnisListe
STR = STR + ";"
Me.RecordSource = STR
Hide_ShowChangeRegister (True)
End Sub
Private Sub Form_Open(cancel As Integer)
Me!Search1 = "Person.PN"
Me!Search2 = "VN"
Me!Search3 = "NN"
Me!Search1Cmp = "="
Me!Search2Cmp = "="
Me!Search3Cmp = "="
Call Search1_AfterUpdate
Call Search2_AfterUpdate
Call Search3_AfterUpdate
Call New_Search_Click
End Sub
Private Sub New_Search_Click()
Me!SearchValue1 = Null
Me!SearchValue2 = Null
Me!SearchValue3 = Null
Call Suche_Click
Hide_ShowChangeRegister (False)
IT STOPS HERE: Me!SearchValue1.SetFocus
End Sub
Private Sub Hide_ShowChangeRegister(val As Boolean)
Me!ChangeRegister.Visible = val
Me!Save.Visible = val
End Sub
Private Sub save_Click()
On Error GoTo Err_Save_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, ,
acMenuVer70
Me.ErgebnisListe.RowSource = Me.ErgebnisListe.RowSource
MsgBox "Mitarbeiter wurde erfolgreich geändert.", vbInformation +
vbOKOnly, "Information"
writelogfile ("person " & Me!VN & " " & Me!NN & " changed")
Exit_Save_Click:
Exit Sub
Err_Save_Click:
MsgBox Err.Description
Resume Exit_Save_Click
End Sub
Private Sub Search1_AfterUpdate()
Dim rs As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set rs = db.OpenRecordset("FieldDescriptionList")
rs.MoveFirst
Do Until rs.EOF
If rs!Field = Me!Search1 Then
If rs!Criteria = "Zahl" Then
Me!Search1Cmp.RowSource = """>"";""="";""<"""
ElseIf rs!Criteria = "Datum" Then
Me!Search1Cmp.RowSource = """>"";""="";""<"""
ElseIf rs!Criteria = "Text" Then
Me!Search1Cmp.RowSource = """="""
End If
End If
rs.MoveNext
Loop
rs.close
End Sub
Private Sub Search2_AfterUpdate()
Dim rs As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set rs = db.OpenRecordset("FieldDescriptionList")
rs.MoveFirst
Do Until rs.EOF
If rs!Field = Me!Search2 Then
If rs!Criteria = "Zahl" Then
Me!Search2Cmp.RowSource = """>"";""="";""<"""
ElseIf rs!Criteria = "Datum" Then
Me!Search2Cmp.RowSource = """>"";""="";""<"""
ElseIf rs!Criteria = "Text" Then
Me!Search2Cmp.RowSource = """="""
End If
End If
rs.MoveNext
Loop
rs.close
End Sub
Private Sub Search3_AfterUpdate()
Dim rs As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set rs = db.OpenRecordset("FieldDescriptionList")
rs.MoveFirst
Do Until rs.EOF
If rs!Field = Me!Search3 Then
If rs!Criteria = "Zahl" Then
Me!Search3Cmp.RowSource = """>"";""="";""<"""
ElseIf rs!Criteria = "Datum" Then
Me!Search3Cmp.RowSource = """>"";""="";""<"""
ElseIf rs!Criteria = "Text" Then
Me!Search3Cmp.RowSource = """="""
End If
End If
rs.MoveNext
Loop
rs.close
End Sub
Private Sub SearchValue1_BeforeUpdate(cancel As Integer)
End Sub
Private Sub Suche_Click()
Dim searchquery As String
' Falls alle Suchfelder leer nicht weitersuchen
If Nz(Me!SearchValue1, 0) = 0 And Nz(Me!SearchValue2, 0) = 0 And
Nz(Me!SearchValue3, 0) = 0 Then
searchquery = ""
Me.ErgebnisListe.RowSource = searchquery
Exit Sub
End If
' Datentypen der Kriterien überprüfen
Dim rs As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set rs = db.OpenRecordset("FieldDescriptionList")
rs.MoveFirst
Do Until rs.EOF
If rs!Field = Me!Search1 And Nz(Me!SearchValue1, 0) <> 0 Then
If rs!Criteria = "Zahl" Then
If Not IsNumeric(SearchValue1) Then
MsgBox "Suchkriterium 1 muss Zahl sein!",
vbInformation + vbOKOnly, "Information"
SearchValue1.SetFocus
Exit Sub
End If
ElseIf rs!Criteria = "Datum" Then
If Not IsDate(SearchValue1) Then
MsgBox "Suchkriterium 1 entspricht nicht einem
Datum!", vbInformation + vbOKOnly, "Information"
SearchValue1.SetFocus
Exit Sub
End If
End If
End If
If rs!Field = Me!Search2 And Nz(Me!SearchValue2, 0) <> 0 Then
If rs!Criteria = "Zahl" Then
If Not IsNumeric(SearchValue2) Then
MsgBox "Suchkriterium 2 muss Zahl sein!",
vbInformation + vbOKOnly, "Information"
SearchValue2.SetFocus
Exit Sub
End If
ElseIf rs!Criteria = "Datum" Then
If Not IsDate(SearchValue2) Then
MsgBox "Suchkriterium 2 entspricht nicht einem
Datum!", vbInformation + vbOKOnly, "Information"
SearchValue2.SetFocus
Exit Sub
End If
End If
End If
If rs!Field = Me!Search3 And Nz(Me!SearchValue3, 0) <> 0 Then
If rs!Criteria = "Zahl" Then
If Not IsNumeric(SearchValue3) Then
MsgBox "Suchkriterium 3 muss Zahl sein!",
vbInformation + vbOKOnly, "Information"
SearchValue3.SetFocus
Exit Sub
End If
ElseIf rs!Criteria = "Datum" Then
If Not IsDate(SearchValue3) Then
MsgBox "Suchkriterium 3 entspricht nicht einem
Datum!", vbInformation + vbOKOnly, "Information"
SearchValue3.SetFocus
Exit Sub
End If
End If
End If
rs.MoveNext
Loop
rs.close
' Zusammensetzen der Abfrage für die Liste entspr. den
Suchkriterien
searchquery = "SELECT Person.PN, Person.TITL AS Titel, Person.NN
AS Nachname, Person.VN AS Vorname, " _
& "Person.MW AS Geschlecht, Person.BER AS Beruf,
Person.GEB AS Geburtsdatum, Person.STR AS Strasse, " _
& "Person.PLZ, Ort.WOO AS Ort, Person.[EIN] AS
Eintrittsdatum, Person.LG AS Lohngruppe, Person.VAZ as
Vorarbeiterzulage, " _
& "Person.CODE1 as Referenzcodeextern, Person.CODE2 as
Referenzcodeintern, Person.MBI as Monatsbrutto, Person.STD as
Normalarbeitszeit, Person.REF AS Referenz, Person.VERW as
Verweildauer, Person.DNGRP1 AS Meister, " _
& "Person.DNGRP2 AS Teamleiter, Person.URLAN AS
UrlaubsanspruchWoche, Person.URLAQ AS Urlausbanspruchaliquot, " _
& "Person.ABW AS Abwesenheit, Person.ABWV AS ABWVON,
Person.ABWB AS ABWBIS, DU.DU AS LetzteUmstuf, " _
& "DU.DU1 AS VorletzteUmstuf, DU.DU2 AS
VorvorletzteUmstuf, Code, Monatslohn, Stdl " _
& "FROM Ort, Person, DU, Lohnschema " _
& "WHERE Ort.PLZ = Person.PLZ and
Lohnschema.Lohngruppe = Person.LG and DU.PN = Person.PN And "
If (Nz(Me!SearchValue1, 0) <> 0) Then
If IsDate(Me!SearchValue1) Then
searchquery = searchquery & Search1 & " " & Search1Cmp & "
#" & Me!SearchValue1 & "# "
ElseIf IsNumeric(Me!SearchValue1) Then
searchquery = searchquery & Search1 & " " & Search1Cmp & "
" & Me!SearchValue1 & " "
Else
searchquery = searchquery & Search1 & " " & "LIKE" & " '"
& Me!SearchValue1 & "*' "
End If
If (Nz(Me!SearchValue2, 0) <> 0) Or (Nz(Me!SearchValue3, 0) <>
0) Then
searchquery = searchquery & "AND "
End If
End If
If (Nz(Me!SearchValue2, 0) <> 0) Then
If IsDate(Me!SearchValue2) Then
searchquery = searchquery & Search2 & " " & Search2Cmp & "
#" & Me!SearchValue2 & "# "
ElseIf IsNumeric(Me!SearchValue2) Then
searchquery = searchquery & Search2 & " " & Search2Cmp & "
" & Me!SearchValue2 & " "
Else
searchquery = searchquery & Search2 & " " & "LIKE" & " '"
& Me!SearchValue2 & "*' "
End If
If (Nz(Me!SearchValue3, 0) <> 0) Then
searchquery = searchquery & "AND "
End If
End If
If (Nz(Me!SearchValue3, 0) <> 0) Then
If IsDate(Me!SearchValue3) Then
searchquery = searchquery & Search3 & " " & Search3Cmp & "
#" & Me!SearchValue3 & "# "
ElseIf IsNumeric(Me!SearchValue3) Then
searchquery = searchquery & Search3 & " " & Search3Cmp & "
" & Me!SearchValue3 & " "
Else
searchquery = searchquery & Search3 & " " & "LIKE" & " '"
& Me!SearchValue3 & "*' "
End If
End If
searchquery = searchquery & ";"
Me.ErgebnisListe.RowSource = searchquery
If Me.ErgebnisListe.ListCount > 1 Then
With Me.ErgebnisListe
.Value = .ItemData(Abs(.ColumnHeads))
Call ErgebnisListe_AfterUpdate
End With
Else
Hide_ShowChangeRegister (False)
Me!SearchValue1.SetFocus
End If
End Sub