Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Kommentare aus Zwischenablage entfernen
#51
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

.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste