msgbox
12.09.2003 18:13:42
Franzel
Ich bin schon weiter gekommen, habe nur noch ein Problem
wie kriege ich den code dazu das er eine weitere MSG BOX öffnet in der ich gefragt werde ob ich ein weiters Farhezeug suchen will oder nicht ??
Damit ihr wißt wo von ich schreibe hier nochmal der Code:
Nach der MSGBOX:
If gef = False And MsgBox("Das Fahrzeug '" & s & "' wurde nicht gefunden !", _
vbExclamation, "das Fahrezug ist nicht in der Liste") Then
möchte ich wie gesagt eine weiter MSGBOX aufrufen, aber wie ???
hier der ganze code:
Sub ladeliste()
Dim SuBe As Range
Dim s As String, za1 As String, za2 As String, za3 As String, za4 As String
Dim I As Long, fiR As Long, laRq As Long, laRz As Long
Dim laC As Integer
Dim gef As Boolean
Const bartikel As String = "artikel"
Const barchiv As String = "archiv"
s = InputBox("bitte das gesuchte Kennzeichen eingeben:", "Fahrzeug suchen und kopieren")
If s = "" Then
MsgBox "Es wurde kein Suchbegriff eingegeben !", vbExclamation, _
"Hinweis für " & Application.UserName & ":"
Exit Sub
End If
fiR = 1
laRq = Sheets(bartikel).Cells(Rows.Count, 1).End(xlUp).Row
For I = 1 To laRq
gef = False
Set SuBe = Sheets(bartikel).Range("A" & fiR).Find(s, lookat:=xlWhole)
If SuBe Is Nothing Then _
Set SuBe = Sheets(bartikel).Range("A" & fiR & ":A" & laRq + 1). _
Find(s, lookat:=xlWhole)
If Not SuBe Is Nothing Then
gef = True
fiR = SuBe.Row + 1
laC = Sheets(bartikel).Cells(SuBe.Row, Columns.Count).End(xlToLeft).Column
za1 = Cells(SuBe.Row, 1).Address(False, False)
za2 = Cells(SuBe.Row, laC).Address(False, False)
Sheets(bartikel).Range(za1 & ":" & za2).copy
'*löscht den gefundenen eintrag
'Sheets(bartikel).Range(za1 & ":" & za2).Delete
laRz = Sheets(barchiv).Cells(Rows.Count, 1).End(xlUp).Row
If laRz = 1 And IsEmpty(Sheets(barchiv).Cells(1, 1)) Then laRz = 0
laRz = laRz + 1
za3 = Cells(laRz, 1).Address(False, False)
za4 = Cells(laRz, laC).Address(False, False)
Sheets(barchiv).Range(za3 & ":" & za4).PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets(bartikel).Range(za1 & ":" & za2).Delete
Else
If gef = False And MsgBox("Das Fahrzeug '" & s & "' wurde nicht gefunden !", _
vbExclamation, "das Fahrezug ist nicht in der Liste") Then
'hier soll sie abfrage rein ob ich weiter suchen möchte oder nicht wenn ja dann suchen
' wenn nein beenden
Exit For
Exit Sub
End If
End If
Exit For
Next I
End Sub
vielen dank für EUre hilfe
mfg
franzel