Private Sub Workbook_Open()
' Auto. Neuberechnung Zellen deaktivieren
Application.Calculation = xlCalculationManual
Dim cell As Range
Dim bereich As Range
Dim blatt As Worksheet
' Durchlaufe alle Blätter und wenn ein Kommentar vorhanden dann auf "Autosize" stellen, _
falls notwenig!
For Each blatt In Worksheets
Set bereich = ActiveWorkbook.Worksheets(blatt.Name).UsedRange
For Each cell In bereich
If Not cell.Comment Is Nothing Then
If cell.Comment.Shape.TextFrame.AutoSize = False Then
cell.Comment.Shape.TextFrame.AutoSize = True
'Debug.Print blatt.Name & ", " & cell.Address
Else
'Debug.Print "Bereits angepatß: " & blatt.Name & ", " & cell.Address
End If
End If
Next
Next
' Info rausgeben
Application.StatusBar = Time & ", Kommentare wurden angepaßt"
' Neuberechnung der Zellen auf auto. stellen
Application.Calculation = xlCalculationAutomatic
End Sub