Jeg havde denne makro liggende. Den skulle kunne klare opgaven.
Sub CommentFix()
' This macro modifies all comments in all open workbooks to:
' (1) move and size with cells
' (2) be physically positioned near the cell to which they correspond
' (3) be optimally sized appropriate to the text within
' This macro was created by combining code posted on the following website:
'
http://www.contextures.com/xlcomments03.htmlDim thisfile As Workbook
Set thisfile = ActiveWorkbook
Dim MyWorkbook As Workbook
Dim MySheet As Worksheet
Dim MyComment As Comment
Dim CommentCount As Long
Dim lArea As Long
Dim fixed As Boolean
fixed = False
On Error GoTo NeedToUnprotect
For Each MyWorkbook In Workbooks
MyWorkbook.Activate
For Each MySheet In MyWorkbook.Sheets
MySheet.Activate
CommentCount = 0
For Each MyComment In MySheet.Comments
With MyComment.Shape
.Placement = xlMoveAndSize
.Top = MyComment.Parent.Top + 5
.Left = MyComment.Parent.Offset(0, 1).Left + 5
.TextFrame.Characters.Font.Name = "Tahoma"
.TextFrame.Characters.Font.Size = 8
.TextFrame.AutoSize = True
CommentCount = CommentCount + 1
End With
If MyComment.Shape.Width > 300 Then
lArea = MyComment.Shape.Width * MyComment.Shape.Height
MyComment.Shape.Width = 200
MyComment.Shape.Height = (lArea / 200) * 1.1
End If
Next MyComment
If CommentCount > 0 Then
MsgBox ("A total of " & CommentCount & " comments in worksheet '" & MySheet.Name & "' of workbook '" & MyWorkbook.Name & "'" & Chr(13) & "were repositioned and resized.")
fixed = True
End If
Next MySheet
Next MyWorkbook
thisfile.Activate
If fixed = False Then
MsgBox ("No comments were detected.")
End If
On Error GoTo 0
Exit Sub
NeedToUnprotect:
MsgBox ("You must unprotect all worksheets before running the macro.")
thisfile.Activate
Exit Sub
End Sub
