Ich benötigte mal wieder eure kompetente Unterstützung.
Da ich für meine tägliche Arbeit Excel-Tabellen mit vielen Kommentaren versehen muss, habe ich mir, dank zahlreicher guter Vorlagen, ein Makro zusammen gebastelt. Das funktioniert soweit auch ganz gut. Leider habe ich nicht die nötige Erfahrung, damit ich es weiter an meine Bedürfnisse anpassen kann.
Das Makro (siehe Code) erfühlt folgende Anforderungen:
- Nach drücken einer Tastenkombination wird die aktuelle Zelle mit Kommentar versehen
- Es wird eine Inputbox aufgerufen, in die ich dann mein Kommentar eintragen kann
- Der fertige Kommentar enthält meine Namen, das aktuelle Datum und den zuvor eingegeben Kommentartext
- Anschließen wird der Kommentar automatisch an das Tabellenblatt angepasst und formatiert
Problem:
Der Code verändert jeden Kommentar innerhalb des Tabellenblattes. Ich möchte aber, dass nur der gerade erstellte verändert wird und mich interessiert auch, ob der Code kürzer geschrieben werden kann?
Vielen Dank für Eure Hilfe
Gruss Basti
Sub CommentInsert()
' CommentInsert
' Tastenkombination: Strg+Umschalt+X
Dim rngCell As Range
Dim rngStart As Range
Dim ws As Worksheet
Dim com As Comment
Dim sCom As String
Application.ScreenUpdating = False
On Error Resume Next
sCom = InputBox( _
prompt:="Bitte Kommentar eingeben:")
With ActiveCell
ActiveCell.AddComment
ActiveCell.Comment.Visible = True
ActiveCell.Comment.Text _
Text:="Name" & " " & Date & ":" & " " & sCom
End With
If Selection.Cells.Count > 1 Then
Set rngStart = Selection.Cells(1)
Else
Set rngStart = Selection
End If
For Each rngCell In rngStart.SpecialCells(xlCellTypeComments)
rngCell.Comment.Shape.TextFrame.AutoSize = True
With rngCell.Comment
.Shape.Top = .Parent.Top - 15
.Shape.Left = .Parent.Offset(0, 1).Left + 10
End With
Next
For Each ws In ActiveWorkbook.Worksheets
For Each com In ws.Comments
If com Is Nothing Then
MsgBox "Es ist kein Kommentar vorhanden."
Else
With com.Shape
With .Fill
.ForeColor.SchemeColor = 1
.Visible = msoTrue
.Transparency = False
End With
.Line.ForeColor.SchemeColor = 0
With .TextFrame
.Orientation = 1
.VerticalAlignment = xlBottom
.AutoSize = True
With .Characters.Font
.Name = "Arial"
.Size = 10
.ColorIndex = 1
.Bold = False
End With
End With
End With
End If
Next com
Next ws
Set rngStart = Nothing
Application.ScreenUpdating = True
End Sub