Kommentare: mathematisch exakte Anordnung

[TxbyFmjy]

Hallo,

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

[LCohen]

... und dann verließen sie Dich anscheinend.