Hallo,
funktioniert wieder perfekt. Danke.
Diesmal hatte ich mir selber schon was "gebastelt". Vielleicht nicht sehr elegant aber funktioniert auch.
Private Sub prcResetDate(ByRef probjTarget As Range)
Dim objCell As Range
Set objCell = Tabelle1.Columns(2).Find(What:=probjTarget.Value, _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
'wenn keine Übereinstimmung dann
If objCell Is Nothing Then
MsgBox ("Unter dieser Nummer ist kein Gerät erfasst!")
Cells(8, 4).Activate
Cells(8, 4).ClearContents
End If
'wenn Übereinstimmung dann
If Not objCell Is Nothing Then
With objCell
Call .Parent.Activate
Call .Select
Select Case fncMsgBoxCustom("Das Gerät mit der Nummer " & .Value & " wurde gefunden," & _
" möchten Sie das Prüfdatum erneuern oder manuelle Änderungen vornehmen?", _
vbExclamation + vbYesNoCancel, "Gerät gefunden!")
Case Is = vbYes
.Offset(0, 2).Value = Date
Call prcActivateSheet(prwksSheet:=Me)
Case Is = vbNo
Call prcActivateSheet(prwksSheet:=Me)
End Select
End With
Set objCell = Nothing
End If
End Sub
Danke dir recht herzlich, im Moment bin ich wunschlos glücklich (und mächtig motiviert meine Kenntnisse zu verbessern).
deba
|