AW: Datum suchen in einer UF
15.07.2004 15:31:04
Erwin
Hallo Ulf
das ist der kompl. Code:
Private Sub CmdSuchen_Click()
Dim name As String, vorname as String
Dim erg As Range
Dim SB1 As String
Dim SB2 As String
Dim LW, BildName, BildDatei
Dim geb As Date
If txtName <> "" Then
GoTo name
ElseIf txtVorname <> "" Then
GoTo vor
ElseIf txtGeb <> "" Then
GoTo geb
End If
name:
name = txtName
With Worksheets("Tabelle1").Range("A:A")
Set erg = .Find(name, LookIn:=xlValues)
If Not erg Is Nothing Then
firstAddress = erg.Address
Do
erg.EntireRow.Select
txtName = ActiveCell.Value
txtVorname = ActiveCell.Offset(0, 1).Value
txtGeb = ActiveCell.Offset(0, 2).Value
txtStr = ActiveCell.Offset(0, 3).Value
txtPLZ = ActiveCell.Offset(0, 4).Value
txtWohn = ActiveCell.Offset(0, 5).Value
txtTel = ActiveCell.Offset(0, 6).Value
txtHandy = ActiveCell.Offset(0, 7).Value
txtBild = ActiveCell.Offset(0, 8).Value
SB1 = txtName
SB2 = txtVorname
LW = "D:\Fotos\"
BildName = SB1 & "_" & SB2
BildDatei = LW & BildName & ".jpg"
If Dir(BildDatei) <> "" Then
Image1.Picture = LoadPicture(BildDatei)
End If
If MsgBox("Weitersuchen?", vbOKCancel + vbQuestion, "Weitersuchen-Dialogfenster") = vbCancel Then Exit Sub
Set erg = .FindNext(erg)
Loop While Not erg Is Nothing And erg.Address <> firstAddress
Else
MsgBox "Es wurde keine Person mit dem Suchbegriff " & name & " gefunden", vbExclamation, "Negativ-Auskunft"
End If
End With
vor:
vorname = txtVorname
With Worksheets("Tabelle1").Range("B:B")
Set erg = .Find(vorname, LookIn:=xlValues)
If Not erg Is Nothing Then
firstAddress = erg.Address
Do
erg.EntireRow.Select
txtName = ActiveCell.Value
txtVorname = ActiveCell.Offset(0, 1).Value
txtGeb = ActiveCell.Offset(0, 2).Value
txtStr = ActiveCell.Offset(0, 3).Value
txtPLZ = ActiveCell.Offset(0, 4).Value
txtWohn = ActiveCell.Offset(0, 5).Value
txtTel = ActiveCell.Offset(0, 6).Value
txtHandy = ActiveCell.Offset(0, 7).Value
txtBild = ActiveCell.Offset(0, 8).Value
SB1 = txtName
SB2 = txtVorname
LW = "D:\Fotos\"
BildName = SB1 & "_" & SB2
BildDatei = LW & BildName & ".jpg"
If Dir(BildDatei) <> "" Then
Image1.Picture = LoadPicture(BildDatei)
End If
If MsgBox("Weitersuchen?", vbOKCancel + vbQuestion, "Weitersuchen-Dialogfenster") = vbCancel Then Exit Sub
Set erg = .FindNext(erg)
Loop While Not erg Is Nothing And erg.Address <> firstAddress
Else
MsgBox "Es wurde keine Person mit dem Suchbegriff " & vorname & " gefunden", vbExclamation, "Negativ-Auskunft"
End If
End With
geb:
geb = CDate(txtGeb)
With Worksheets("Tabelle1").Range("C:C")
Set erg = .Find(geb, LookIn:=xlValues)
If Not erg Is Nothing Then
firstAddress = erg.Address
Do
erg.EntireRow.Select
txtName = ActiveCell.Value
txtVorname = ActiveCell.Offset(0, 1).Value
txtGeb = ActiveCell.Offset(0, 2).Value
txtStr = ActiveCell.Offset(0, 3).Value
txtPLZ = ActiveCell.Offset(0, 4).Value
txtWohn = ActiveCell.Offset(0, 5).Value
txtTel = ActiveCell.Offset(0, 6).Value
txtHandy = ActiveCell.Offset(0, 7).Value
txtBild = ActiveCell.Offset(0, 8).Value
SB1 = txtName
SB2 = txtVorname
LW = "D:\Fotos\"
BildName = SB1 & "_" & SB2
BildDatei = LW & BildName & ".jpg"
If Dir(BildDatei) <> "" Then
Image1.Picture = LoadPicture(BildDatei)
End If
If MsgBox("Weitersuchen?", vbOKCancel + vbQuestion, "Weitersuchen-Dialogfenster") = vbCancel Then Exit Sub
Set erg = .FindNext(erg)
Loop While Not erg Is Nothing And erg.Address <> firstAddress
Else
MsgBox "Es wurde keine Person mit dem Suchbegriff " & geb & " gefunden", vbExclamation, "Negativ-Auskunft"
End If
End With
End Sub