Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
i.oana Profile
 | Femeie
20 ani
Bucuresti
cauta Barbat
20 - 45 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 748
|
|
Source & credits to Col Delane:
Sub Resize_Relocate_CellComments()
' Purpose: Adjust size of all cell comment boxes on the active sheet of the active workbook to match the comment text therein, and locate it proximate to the host cell
'Define Procedure Variables
Dim wbk As Workbook
Dim wks As Worksheet
Dim cmt As Comment
Dim lArea As Long
On Error GoTo ErrorHandler
Set wbk = ActiveWorkbook
Set wks = ActiveSheet
Select Case MsgBox("Click:" & vbLf & vbLf & "YES to review & fix comments on ALL sheets in the Active WORKBOOK," & vbLf & vbLf & "NO to review & fix comments on the Active SHEET only, or" & vbLf & vbLf & "CANCEL to abort this process.", vbYesNoCancel Or vbQuestion Or vbDefaultButton2, "Cell Comments Resize and Relocation")
Case vbYes
For Each wks In wbk.Worksheets
Application.StatusBar = "Adjusting comments on " & wks.Name
For Each cmt In wks.Comments
With cmt
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 300 Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = 200
.Shape.Height = (lArea / 200) * 1.1
End If
.Shape.Top = cmt.Parent.Top + 5
.Shape.Left = .Parent.Offset(0, 1).Left + 5
End With
Next cmt
Next wks
Case vbNo
Application.StatusBar = "Adjusting comments on " & wks.Name
For Each cmt In wks.Comments
With cmt
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 300 Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = 200
.Shape.Height = WorksheetFunction.Min((lArea / 200) * 1.1, 100)
End If
.Shape.Top = cmt.Parent.Top + 5
.Shape.Left = .Parent.Offset(0, 1).Left + 5
End With
Next cmt
Case vbCancel
Exit Sub
End Select
Application.StatusBar = False
MsgBox "All cell comments resized and located proximate to their parent cell.", vbOKOnly, "Cell Comment Autosizing & Relocator"
ExitPoint: '---------------->>>>>>>>>-------------------->>>>>>>>>-------------------->>>>>>>>> Exit Sub
On Error GoTo 0
Exit Sub
ErrorHandler:
Resume ExitPoint
End Sub
'----------------------------------------------------------- |
|
|
| pus acum 4 ani |
|