21.08.2021, 10:39
Hallo,
Ordnung ist das halbe Leben. Aus diesem Grund habe ich das nachfolgende wichtige Makro zusammengestellt:
Ordnung ist das halbe Leben. Aus diesem Grund habe ich das nachfolgende wichtige Makro zusammengestellt:
Code:
Option Explicit
Private Sub comments_mathematical_exact_arrangement()
Dim objComment As Comment
Dim i As Long
Dim j As Double
Dim z As Double
i = 0
If ActiveSheet.Comments.Count = 0 Then
MsgBox "No comments in entire sheet"
Exit Sub
End If
' Alle Kommentare des aktuellen Arbeitsblatts durchlaufen
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each objComment In ActiveSheet.Comments
i = i + 1
z = Rnd
If z <= 0.1 Then
j = i * z ^ 1
ElseIf z <= 0.2 Then j = i * z ^ 2
ElseIf z <= 0.3 Then j = i * z ^ 3
ElseIf z <= 0.4 Then j = i * z ^ 4
ElseIf z <= 0.5 Then j = i * z ^ 5
ElseIf z <= 0.6 Then j = i * z ^ 6
ElseIf z <= 0.7 Then j = i * z ^ 7
ElseIf z <= 0.8 Then j = i * z ^ 8
ElseIf z <= 0.9 Then j = i * z ^ 9
ElseIf z <= 1 Then j = i * z ^ 10
End If
With objComment
If j <= 10 Then
.Shape.Top = .Parent.Top + (.Parent.Height * (j / 10))
.Shape.Left = .Parent.Left + (.Parent.Width * (j / 10))
ElseIf j <= 100 Then
.Shape.Top = .Parent.Top + (.Parent.Height * (j / 10))
.Shape.Left = .Parent.Left + (.Parent.Width * (j / 100))
ElseIf j <= 1000 Then
.Shape.Top = .Parent.Top + (.Parent.Height * (j / 10))
.Shape.Left = .Parent.Left + (.Parent.Width * (j / 1000))
ElseIf j <= 10000 Then
.Shape.Top = .Parent.Top + (.Parent.Height * (j / 100))
.Shape.Left = .Parent.Left + (.Parent.Width * (j / 100))
End If
End With
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
On Error GoTo 0
End Sub