Hi All,
First of all thank you for you're help, your about to cure my head ache
I have this running (see below) and I am trying to run the macro but it's telling me I need to unprotect the sheet, but it's not protected, im not an expert when it comes to all this but it has been working fine.
can some one help me with this pleeease
I can't add the screen shot for some reason
Dim 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
First of all thank you for you're help, your about to cure my head ache
I have this running (see below) and I am trying to run the macro but it's telling me I need to unprotect the sheet, but it's not protected, im not an expert when it comes to all this but it has been working fine.
can some one help me with this pleeease
I can't add the screen shot for some reason
Dim 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