Sub Zellinhalt_Kommentar()
Dim raZelle As Range
Dim strSuchbegriff As String
Dim firstAddress As String
Dim strAbfrage As String
'Dim strKommentar As String
sPath = "C:\Margencheck\"
X_Workbook = InputBox(prompt:="Bitte Datei-Namen eingeben")
If X_Workbook = "" Then Exit Sub
On Error GoTo ErrorHandler_1
Workbooks.OpenText Filename:=sPath & X_Workbook & ".dat"
On Error GoTo Fehler
strSuchbegriff = InputBox("Elektronischer User, der umgesetzt werden soll:")
With Worksheets("Margencheck").Range("M:M")
Set raZelle = .Find(strSuchbegriff, lookat:=xlWhole, LookIn:=xlValues)
If Not raZelle Is Nothing Then
MsgBox "User: " & raZelle & " Beleg: " & raZelle.Offset(0, -12).Text, vbInformation, _
_
"Hinweis für " & Application.UserName & ":"
firstAddress = raZelle.Address
Do
raZelle.Activate
' strKommentar = InputBox("Bitte Änderungs-User für Beleg eingeben. ")
raZelle = InputBox("Bitte Änderungs-User für Beleg eingeben:")
' With raZelle
' .AddComment
' .Comment.Text Text:=strKommentar
' End With
strAbfrage = MsgBox(" Weitersuchen? ", vbYesNo)
If strAbfrage = vbNo Then
Exit Sub
End If
Set raZelle = .FindNext(raZelle)
' Hier geht das Programm auf END
raZelle = InputBox("User: " & raZelle & " Beleg: " & raZelle.Offset(0, -12).Text, _
vbInformation, _
"Hinweis für " & Application.UserName & ":" & vbCrLf & "Bitte Änderungs-User für _
Beleg eingeben:", "User Eingabe")
' MsgBox "User: " & raZelle & " Beleg: " & raZelle.Offset(0, -12).Text, _
vbInformation, _
' "Hinweis für " & Application.UserName & ":"
Loop While Not raZelle Is Nothing And raZelle.Address firstAddress
End If
End With
If raZelle Is Nothing Then MsgBox "Suchbegriff nicht gefunden"
Fehler:
' ErrorHandler_1:
' MsgBox "Datei nicht gefunden"
End
ErrorHandler_1:
MsgBox "Datei nicht gefunden"
End Sub
Sub Zellinhalt_Kommentar()
Dim raZelle As Range
Dim strSuchbegriff As String
Dim firstAddress As String
Dim strAbfrage As String
Dim strKommentar As String
sPath = "C:\Margencheck\"
X_Workbook = InputBox(prompt:="Bitte Datei-Namen eingeben")
If X_Workbook = "" Then Exit Sub
On Error GoTo ErrorHandler_1
Workbooks.OpenText Filename:=sPath & X_Workbook & ".dat"
'On Error GoTo Fehler
strSuchbegriff = InputBox("Elektronischer User, der umgesetzt werden soll:")
With ActiveWorkbook.Worksheets("Margencheck").Range("M:M")
Set raZelle = .Find(strSuchbegriff, lookat:=xlWhole, LookIn:=xlValues)
If Not raZelle Is Nothing Then
firstAddress = raZelle.Address
Do
raZelle.Activate
strKommentar = InputBox("User: " & raZelle & " Beleg: " & raZelle.Offset(0, -12). _
Text, "Hinweis für " & Application.UserName & ":" & vbCrLf & _
" Bitte Änderungs-User für Beleg eingeben:", "User Eingabe")
With raZelle
.AddComment
.Comment.Text Text:=strKommentar
End With
strAbfrage = MsgBox(" Weitersuchen? ", vbYesNo)
If strAbfrage = vbNo Then
Exit Sub
End If
Set raZelle = .FindNext(raZelle)
Loop While Not raZelle Is Nothing And raZelle.Address firstAddress
End If
End With
If raZelle Is Nothing Then MsgBox "Suchbegriff nicht gefunden"
Fehler:
' ErrorHandler_1:
' MsgBox "Datei nicht gefunden"
End
ErrorHandler_1:
MsgBox "Datei nicht gefunden"
End Sub
Da Du ja die Tabelle oeffnest und wohl auch in dieser nun geoeffneten Datei suchen willst (im Arbeitsblatt 'Margencheck' musst Du da Activeworkbooks.Worksheets("Margencheck") in deine With-anweisung packen.
Fuer die Dateinamensabfrage solltest Du darauf hinweisen, das die Dateienedung nicht mit eingegeben werden darf.
Lass' mal hoeren, ob so ok.
Gruss
Dirk aus Dubai