Ist das bei Excel alles ganz normal?

[Kuwer]

Hallöchen,

Hast Du nun mal versucht, Kommentare mit einem eigenen Makro einzufügen, zu bearbeiten und zu löschen?

Kommentare aus Zellinhalten generieren

Gruß Uwe

[TxbyFmjy]

Hallöchen,

VBA:

Oder Du hast eine Standardgröße und stellst diese vor dem Speichern der Datei wieder her.
Oder ...

Diese Schnipsel gehören nicht in ein Modul, sondern unter Microsoft Exel Objekte in DieseArbeitsmappe.

Update: Diese Lösung funktioniert auch, wenn die Arbeitsmappe mehrere Tabellen enthält und auch dann, wenn zwischen Tabellen mehrfach hin- und hergewechselt wird.

Diese Lösung setzt voraus, dass die Seitenverhälltnisse aller Kommentare identisch sind, z. Bsp.: Vereinslogo wurde als Hintergrundbild eingefügt.

Diese Lösung bringt jedoch leider auch ein Problem mit sich, wenn die Tabelle Hunderte oder über Tausend Kommentare enthält, weil dann das Speichern der Datei für Benutzer*innen inakzeptabel lange dauert.

Code:

Option Explicit
Dim ScaleValue1(1 To 100) As Double
Dim AktiveTabelle(1 To 100) As String
Dim c As Integer
Dim cmtc As Long
Dim u As Integer
Dim v As Integer

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim objComment As Comment
Dim ScaleValue2 As Double
cmtc = 0
u = 0
v = 0

For u = 1 To 100 '** bei wiederholtem sofortigen Wechsel zur selben Tabelle (mit nur einer anderen Tabelle dazwischen), _
wird die Tabelle nur einmal berücksichtigt, die anderen Kommentar-Seitenverhältnisse derselben Tabelle werden zu Null gesetzt _
und an Hand dessen übersprungen; so werden Mehrfach-Berechnungen vermieden.
For v = (u + 1) To 100
If AktiveTabelle(u) = AktiveTabelle(v) Then
ScaleValue1(v) = 0
End If
Next v
Next u

For c = 1 To c

If AktiveTabelle(c) = "" Then
GoTo LabelSkip2
ElseIf ScaleValue1(c) = 0 Then '** Tabellen deren Kommentar-Seitenverhältnis zu Null gesetzt wurde, werden übersprungen
GoTo LabelSkip1
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each objComment In Worksheets(AktiveTabelle(c)).Comments

cmtc = cmtc + 1

'Resize
        With objComment.Shape

            .LockAspectRatio = msoFalse
            .TextFrame.AutoSize = False

        ScaleValue2 = .Height / .Width

        Debug.Print cmtc; c; ScaleValue1(c); ScaleValue2; AktiveTabelle(c)

        If ScaleValue2 <> ScaleValue1(c) Then
        .Width = 150
        .Height = .Width * ScaleValue1(c)

            .LockAspectRatio = msoTrue

        Debug.Print cmtc; c; ScaleValue1(c); ScaleValue2; .Width; .Height

        End If
        End With

        Debug.Print cmtc; c; ScaleValue1(c); ScaleValue2; objComment.Shape.Width; objComment.Shape.Height

Next objComment

LabelSkip1:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

DoEvents

Next c

LabelSkip2:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

For c = 1 To c
Debug.Print c; ScaleValue1(c); AktiveTabelle(c)
Next

End Sub

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim objComment As Comment
Dim ScaleValue2 As Double
cmtc = 0
u = 0
v = 0

For u = 1 To 100
For v = (u + 1) To 100
If AktiveTabelle(u) = AktiveTabelle(v) Then
ScaleValue1(v) = 0
End If
Next v
Next u

For c = 1 To c

If AktiveTabelle(c) = "" Then
GoTo LabelSkip2
ElseIf ScaleValue1(c) = 0 Then
GoTo LabelSkip1
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each objComment In Worksheets(AktiveTabelle(c)).Comments

cmtc = cmtc + 1

'Resize
        With objComment.Shape

            .LockAspectRatio = msoFalse
            .TextFrame.AutoSize = False

        ScaleValue2 = .Height / .Width

        Debug.Print cmtc; c; ScaleValue1(c); ScaleValue2; AktiveTabelle(c)

        If ScaleValue2 <> ScaleValue1(c) Then
        .Width = 150
        .Height = .Width * ScaleValue1(c)

            .LockAspectRatio = msoTrue

        Debug.Print cmtc; c; ScaleValue1(c); ScaleValue2; .Width; .Height

        End If
        End With

        Debug.Print cmtc; c; ScaleValue1(c); ScaleValue2; objComment.Shape.Width; objComment.Shape.Height

Next objComment

LabelSkip1:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

DoEvents

Next c

LabelSkip2:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

For c = 1 To c
Debug.Print c; ScaleValue1(c); AktiveTabelle(c)
Next

End Sub

Code:

Private Sub Workbook_Open()
Dim objComment As Comment
Dim i As Integer
Dim SV As Double
i = 0
c = 0
c = c + 1

For Each objComment In ActiveSheet.Comments
i = i + 1
With objComment.Shape
SV = .Height / .Width
End With
If i = 1 Then GoTo LabelFinish
Next
LabelFinish:
ScaleValue1(c) = SV
AktiveTabelle(c) = ActiveSheet.Name
Debug.Print c; SV; ScaleValue1(c); AktiveTabelle(c)
End Sub

Code:

Private Sub Workbook_SheetActivate(ByVal Sh As Object) '** Seitenverhältnis beim Tabellenwechsel wird ermittelt
Dim objComment As Comment
Dim i As Integer
Dim SV As Double
i = 0
c = c + 1

For Each objComment In ActiveSheet.Comments
i = i + 1
With objComment.Shape
SV = .Height / .Width
End With
If i = 1 Then GoTo LabelFinish
Next
LabelFinish:
ScaleValue1(c) = SV
AktiveTabelle(c) = ActiveSheet.Name
Debug.Print c; SV; ScaleValue1(c); AktiveTabelle(c)
End Sub

Im Modul1 befindet sich zum Durcheinanderbringen aller Kommentare folgendes Schnipsel:

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
           
                .Shape.TextFrame.AutoSize = True
           
                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

Gerne wiederhole ich mich selbst:

Eine abgerundete Lösung zu finden, ist nicht trivial.

  comment size change revert back picture (3).xlsm (Größe: 1,48 MB / Downloads: 0)

---

Hallöchen,

warum postest Du eigentlich die Codes mit ...SelectionChange... wenn die Deinem Anspruch wegen der eingeschränkten UNDO-Funktion nicht gerecht werden?

Ich hatte dieses funktionierende Schnipsel ausgearbeitet, dann erst entdeckt welcher Nachteil damit verbunden ist und dieses Schnipsel der Vollständigkeit halber trotzdem gepostet. Im Schnipsel steht der Nachteil. Sorry, arm dran, wer das nicht versteht.

Die Schnipsel in meinem vorletzten Post enthalten kein SelectionChange mehr.

Das Beste kommt immer erst zum Schluss.

Hallöchen,

Hast Du nun mal versucht, Kommentare mit einem eigenen Makro einzufügen, zu bearbeiten und zu löschen?

Immer mit der Ruhe. Zuerst einmal werde ich mich damit beschäftigen, ob das mit irgendwelchen nicht unwesentlichen Nachteilen verbunden ist und ob ich diese Lösung überhaupt noch brauche.

Und jetzt muss ich die Ruhezeiten im Homeoffice beachten.

[TxbyFmjy]

Hallöchen,

warum postest Du eigentlich die Codes mit ...SelectionChange... wenn die Deinem Anspruch wegen der eingeschränkten UNDO-Funktion nicht gerecht werden?

Ausschließlich deshalb, damit nachvollziehbar wird wie absichtlich unterirdisch oberflächlich manche Vorschläge sind. Wir wissen das.

Hallöchen,

VBA:

Zum Verhindern oder zumindest Erschweren könnte man ggf. den Menüpunkt Kommentar bearbeiten aus dem Kontextmenü entfernen. Dann geht aber auch Ändern nicht mehr.

Wir wissen das: Wird "Kommentar einfügen" Enabled = False, dann lassen sich Kommentare nicht nur nicht mehr ändern, sondern es lassen sich überhaupt keine Kommentare mehr einfügen. Wird mit "Kommentar einfügen" ein Kommentar eingefügt, dann wechselt "Kommentar einfügen" zu "Kommentar bearbeiten". "Kommentar einfügen" = "Kommentar bearbeiten", sobald ein Kommentar eingefügt wurde. "Kommentar bearbeiten" lässt sich streng genommen nicht auf Enabled = False setzen. Deshalb ist 'Menüpunkt "Kommentar bearbeiten" aus dem Kontextmenü entfernen' keine Lösung.

Hallöchen,

VBA:

Alternativ könnte man mit etwas Aufwand beim Wechsel in eine Zelle die Kommentargröße ermitteln und beim Wechsel in eine andere Zelle die Kommentargröße der vorherigen Zelle wiederherstellen.

Wir wissen das: Nachteil dieser Lösung: Beachte aber, dass das Ausführen des Worksheet_SelectionChange Makros den Undo Stack zerstört, sodass bei der Benutzung dieser Technik de facto Excel's Undo Feature deaktiviert wird.

Nicht "mein Anspruch", sondern Fachwissen aus einem Fachbuch:

Excel 2016, Power Programming with VBA (Ich habe nur die englische Ausgabe.)

Keep in mind however, that executing the Worksheet_SelectionChange macro destroys the Undo stack, so using this technique essentially disables Excel's Undo feature.

Excel's Undo stack is destroyed whenever an event procedure makes a change to the worksheet.

Code:

Sub M_snb()
    For Each it In Tabelle1.Comments
        With it.Shape
            .LockAspectRatio = -1
            .TextFrame.AutoSize = 0
        End With
    Next
End Sub

.LockAspectRatio = -1

Hallöchen,

Hallöchen,

Hast Du nun mal versucht, Kommentare mit einem eigenen Makro einzufügen, zu bearbeiten und zu löschen?

Kommentare aus Zellinhalten generieren

Gruß Uwe

Hallo,

das hier kannst Du bei Bedarf besser anpassen/ergänzen:

Code:

Sub kommentar_aus_rngZelle_einfuegen_2()
  '** Dimensionierung der Variablen
  Dim rngZelle As Range
 
  '** Alle markierten rngZellen durchlaufen
  For Each rngZelle In Selection.Cells
    With rngZelle
      If Not .Comment Is Nothing Then
        If Len(.Value) Then
          .Comment.Text Date & Chr(10) & .Value
        Else
          '.Comment.Delete
        End If
      Else
        If .Value = "ja" Then
          .AddComment.Text Date & Chr(10) & .Value
        End If
      End If
    End With
  Next rngZelle
End Sub

Gruß Uwe

.Comment.Delete


Jedes Forum ist andersartig. 

Jeder bilde sich seine eigene Meinung.


Und jetzt muss ich die Ruhezeiten im Homeoffice beachten.

[schauan]

Hallöchen,

Und jetzt muss ich die Ruhezeiten im Homeoffice beachten.

morgen sicher auch wieder, oder?

[TxbyFmjy]

Fehlerkorrektur:

Bei comment size change revert back picture (3).xlsm hatte ich vergessen die Auskommentierung von Blöcken aufzuheben.

Code:

For v = (u + 1) To 100 '** falsch

Code:

For v = (u + 2) To 100 '** richtig

Diese Schnipsel gehören nicht in ein Modul, sondern unter Microsoft Exel Objekte in DieseArbeitsmappe.

Update: Diese Lösung funktioniert auch, wenn die Arbeitsmappe mehrere Tabellen enthält und auch dann, wenn zwischen Tabellen mehrfach hin- und hergewechselt wird.

Diese Lösung setzt voraus, dass die Seitenverhälltnisse aller Kommentare identisch sind, z. Bsp.: Vereinslogo wurde als Hintergrundbild eingefügt.

Diese Lösung bringt jedoch leider auch ein Problem mit sich, wenn die Tabelle Hunderte oder über Tausend Kommentare enthält, weil dann das Speichern der Datei für Benutzer*innen inakzeptabel lange dauert.

Code:

Option Explicit
Dim ScaleValue1(1 To 100) As Double
Dim AktiveTabelle(1 To 100) As String
Dim c As Integer
Dim cmtc As Long
Dim u As Integer
Dim v As Integer

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim objComment As Comment
Dim ScaleValue2 As Double
cmtc = 0
u = 0
v = 0

For u = 1 To 100 '** bei wiederholtem sofortigen Wechsel zur selben Tabelle (mit nur einer anderen Tabelle dazwischen), _
wird die Tabelle nur einmal berücksichtigt, die anderen Kommentar-Seitenverhältnisse derselben Tabelle werden zu Null gesetzt _
und an Hand dessen übersprungen; so werden Mehrfach-Berechnungen vermieden.
For v = (u + 2) To 100
If AktiveTabelle(u) = AktiveTabelle(v) Then
ScaleValue1(v) = 0
End If
Next v
Next u

For c = 1 To c

If AktiveTabelle(c) = "" Then
GoTo LabelSkip2
ElseIf ScaleValue1(c) = 0 Then '** Tabellen deren Kommentar-Seitenverhältnis zu Null gesetzt wurde, werden übersprungen
GoTo LabelSkip1
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each objComment In Worksheets(AktiveTabelle(c)).Comments

cmtc = cmtc + 1

'Resize
        With objComment.Shape

            .LockAspectRatio = msoFalse
            .TextFrame.AutoSize = False

        ScaleValue2 = .Height / .Width

        Debug.Print cmtc; c; ScaleValue1(c); ScaleValue2; AktiveTabelle(c)

        If ScaleValue2 <> ScaleValue1(c) Then
        .Width = 150
        .Height = .Width * ScaleValue1(c)

            .LockAspectRatio = msoTrue

        Debug.Print cmtc; c; ScaleValue1(c); ScaleValue2; .Width; .Height

        End If
        End With

        Debug.Print cmtc; c; ScaleValue1(c); ScaleValue2; objComment.Shape.Width; objComment.Shape.Height

Next objComment

LabelSkip1:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

DoEvents

Next c

LabelSkip2:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

For c = 1 To c
Debug.Print c; ScaleValue1(c); AktiveTabelle(c)
Next

End Sub

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim objComment As Comment
Dim ScaleValue2 As Double
cmtc = 0
u = 0
v = 0

For u = 1 To 100
For v = (u + 2) To 100
If AktiveTabelle(u) = AktiveTabelle(v) Then
ScaleValue1(v) = 0
End If
Next v
Next u

For c = 1 To c

If AktiveTabelle(c) = "" Then
GoTo LabelSkip2
ElseIf ScaleValue1(c) = 0 Then
GoTo LabelSkip1
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each objComment In Worksheets(AktiveTabelle(c)).Comments

cmtc = cmtc + 1

'Resize
        With objComment.Shape

            .LockAspectRatio = msoFalse
            .TextFrame.AutoSize = False

        ScaleValue2 = .Height / .Width

        Debug.Print cmtc; c; ScaleValue1(c); ScaleValue2; AktiveTabelle(c)

        If ScaleValue2 <> ScaleValue1(c) Then
        .Width = 150
        .Height = .Width * ScaleValue1(c)

            .LockAspectRatio = msoTrue

        Debug.Print cmtc; c; ScaleValue1(c); ScaleValue2; .Width; .Height

        End If
        End With

        Debug.Print cmtc; c; ScaleValue1(c); ScaleValue2; objComment.Shape.Width; objComment.Shape.Height

Next objComment

LabelSkip1:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

DoEvents

Next c

LabelSkip2:

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

For c = 1 To c
Debug.Print c; ScaleValue1(c); AktiveTabelle(c)
Next

End Sub

Code:

Private Sub Workbook_Open()
Dim objComment As Comment
Dim i As Integer
Dim SV As Double
i = 0
c = 0
c = c + 1

For Each objComment In ActiveSheet.Comments
i = i + 1
With objComment.Shape
SV = .Height / .Width
End With
If i = 1 Then GoTo LabelFinish
Next
LabelFinish:
ScaleValue1(c) = SV
AktiveTabelle(c) = ActiveSheet.Name
Debug.Print c; SV; ScaleValue1(c); AktiveTabelle(c)
End Sub

Code:

Private Sub Workbook_SheetActivate(ByVal Sh As Object) '** Seitenverhältnis beim Tabellenwechsel wird ermittelt
Dim objComment As Comment
Dim i As Integer
Dim SV As Double
i = 0
c = c + 1

For Each objComment In ActiveSheet.Comments
i = i + 1
With objComment.Shape
SV = .Height / .Width
End With
If i = 1 Then GoTo LabelFinish
Next
LabelFinish:
ScaleValue1(c) = SV
AktiveTabelle(c) = ActiveSheet.Name
Debug.Print c; SV; ScaleValue1(c); AktiveTabelle(c)
End Sub

Im Modul1 befindet sich zum Durcheinanderbringen aller Kommentare folgendes Schnipsel:

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
           
                .Shape.TextFrame.AutoSize = True
           
                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

  comment size change revert back picture (4).xlsm (Größe: 1,48 MB / Downloads: 1)

[TxbyFmjy]

Hallöchen,


Kommentare aus Zellinhalten generieren

Gruß Uwe

Hast du das schon einmal ausprobiert?

Kommentare mit einem eigenen Makro einfügen

---

Hallöchen,

warum postest Du eigentlich die Codes mit ...SelectionChange... wenn die Deinem Anspruch wegen der eingeschränkten UNDO-Funktion nicht gerecht werden?
Du fügst die auch häufig als Zitat ein. Soll das auch für den aufmerksamen Leser gut sein? Ich finde das ziemlich hinderlich. Die Threads werden immer länger und unübersichtlicher und es wird immer schwieriger, herauszufinden, was Du willst und was nicht. Gilt das mit dem UNDO vielleicht inzwischen nicht mehr, weil es im Zitat fehlt? Falls doch, wie gesagt, es fällt nicht leicht, zwischen den ganzen Zitaten einzelne Info's zu finden ...

Hast Du nun mal versucht, Kommentare mit einem eigenen Makro einzufügen, zu bearbeiten und zu löschen?

Ich habe Excel-Makro-Dateien hochgeladen, die für das kostenlose ausprobieren förderlich sind. Excel-Makro-Datei downloaden, ausprobieren, modifizieren, error feedbacken. Nicht hinderlich, sondern förderlich.

Was ich will, erschließt sich trivial ohne Erklärung: ein funktionierendes Makro.

Hast du das schon ausprobiert?

Bilder in Kommentaren: Seitenverhältnisse bewahren

---

Code:

Sub M_snb()
    For Each it In Tabelle1.Comments
        With it.Shape
            .LockAspectRatio = -1
            .TextFrame.AutoSize = 0
        End With
    Next
End Sub

Hast du das schon ausprobiert?

For Each shit in sheet