Kommentare aus Zwischenablage entfernen

[schauan]

Hallöchen,

so - ist aber ungetestet. Der Code zum Auslesen muss, je nach Erfordernis, vor oder nach das Undo - hatte ich geschrieben, aber keinen Hinweis erhalten. Ich hab den daher jetzt 2x drin, vor dem UNDO aktiv und danach auskommentiert.

Option Explicit
 
'Automatisches Einfügen eines Kommentars bei Ändern des Zellinhaltes 
'Automatisches Löschen eines Kommentars bei Entfernen des Zellinhaltes 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rngZelle As Range
  Dim varT As Variant
  Dim oComment As Comment
  'Variablendeklarationen - String 
  Dim strAddr$, strSubAddr$
  With Target.Areas(1)
    varT = .Formula
    
'*********'Adresse und Subadresse auslesen 
    'Hinweis: ist nix vorhanden, kommt es ggf. zu einem Laufzeitfehler! 
    strSubAddr = ActiveCell.Hyperlinks(1).SubAddress
    strAddr = ActiveCell.Hyperlinks(1).Address
'*********'Ende Adresse und Subadresse auslesen 
        
    On Error Resume Next
    Application.EnableEvents = False
    Set rngZelle = ActiveCell
    Application.Undo
'---> oder hier hin 
'*********'Adresse und Subadresse auslesen 
'    'Hinweis: ist nix vorhanden, kommt es ggf. zu einem Laufzeitfehler! 
'    strSubAddr = ActiveCell.Hyperlinks(1).SubAddress 
'    strAddr = ActiveCell.Hyperlinks(1).Address 
'*********'Ende Adresse und Subadresse auslesen 
    rngZelle.Activate
    .Formula = varT
    For Each rngZelle In .Cells
      With rngZelle
        If .Column = 6 Then 'wenn Spalte F 
          'eventuell vorhandenen Link löschen 
          ActiveCell.Hyperlinks.Delete
'*********'Link hinzufuegen 
          ActiveSheet.Hyperlinks.Add anchor:=ActiveCell, _
               Address:=strAddr, SubAddress:=strSubAddr
'*********'Ende eventuell vorhandenen Link löschen 
        End If
        Select Case .Column
          Case 1, 17  'Zelle befindet sich in Spalte A oder Q 
            If Len(.Formula) Then
              If .Comment Is Nothing Then
                .AddComment.Text Application.UserName & Chr(10) & Date & " " & Format(Time, "hh:mm:ss")
              Else
                .Comment.Text Application.UserName & Chr(10) & Date & " " & Format(Time, "hh:mm:ss") & _
                  Chr(10) & .Comment.Text
              End If
              .Comment.Shape.TextFrame.AutoSize = True
            Else
              If Not .Comment Is Nothing Then
                .Comment.Delete
              End If
            End If
          Case Else 'Zelle befindet sich in einer anderen Spalte 
            If Not .Comment Is Nothing Then
              .Comment.Delete
            End If
        End Select
      End With
    Next rngZelle
    Application.EnableEvents = True
    On Error GoTo 0
  End With
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0