Private Sub worksheet_Change(ByVal Target As Range)
On Error GoTo fehler
Application.EnableEvents = False
With Worksheet
If Range(Target.Address) > 0 And Range(Target.Address) < 6 Then
Cells(Target.Row, Target.Column + 1).AddComment
Cells(Target.Row, Target.Column + 1).Comment.Text Text:="Toll"
Cells(Target.Row, Target.Column + 1).Comment.Visible = False
End If
If Range(Target.Address) > 5 And Range(Target.Address) < 11 Then
Cells(Target.Row, Target.Column + 1).AddComment
Cells(Target.Row, Target.Column + 1).Comment.Text Text:="Noch Toller"
Cells(Target.Row, Target.Column + 1).Comment.Visible = False
End If
If Range(Target.Address) > 10 And Range(Target.Address) < 16 Then
Cells(Target.Row, Target.Column + 1).AddComment
Cells(Target.Row, Target.Column + 1).Comment.Text Text:="Noch Viel Toller"
Cells(Target.Row, Target.Column + 1).Comment.Visible = False
End If
End With
fehler:
If Err = 1004 Then
Cells(Target.Row, Target.Column + 1).ClearComments
Cells(Target.Row, Target.Column + 1).AddComment
Cells(Target.Row, Target.Column + 1).Comment.Visible = False
Resume Next
End If
Application.EnableEvents = True
End Sub
Sub KommentarFuellen()
On Error GoTo fehler
Dim AdressZelle(1) As String
Dim adress As String
Dim zeichenzaehler As Integer
Dim zeile As Long
Dim zaehler0 As Integer
Dim spalte As Integer
Dim laenge As Integer
adress = ActiveWindow.RangeSelection.Address
For zeichenzaehler = 1 To Len(ActiveWindow.RangeSelection.Address)
If Mid$(adress, zeichenzaehler, 1) = ":" Then
zaehler0 = zaehler0 + 1
zeichenzaehler = zeichenzaehler + 1
End If
If Mid$(adress, zeichenzaehler, 1) <> "$" Then
AdressZelle(zaehler0) = AdressZelle(zaehler0) + Mid$(adress, zeichenzaehler, 1)
End If
Next zeichenzaehler
For zeile = Val(Mid$(AdressZelle(0), 2, Len(AdressZelle(0)))) To Val(Mid$(AdressZelle(1), 2, Len(AdressZelle(1))))
For spalte = Asc(Mid$(AdressZelle(0), 1, 1)) To Asc(Mid$(AdressZelle(1), 1, 1))
laenge = Len(Str(Range(Chr$(spalte%) & zeile)))
Range(Chr$(spalte) & zeile).AddComment
rem zur zeit wird der text "Toll" uebernommen,gegebenenfalls anzupassen
rem die rem zeile zeigt wie von einer zelle der inhalt uebernommen wird
Rem Range(Chr$(spalte) & zeile).Comment.Text Text:=Range("A1").Value
Range(Chr$(spalte) & zeile).Comment.Text Text:="Toll"
Range(Chr$(spalte) & zeile).Comment.Visible = False
Next spalte
Next zeile
fehler:
If Err = 1004 Then
Range(Chr$(spalte) & zeile).ClearComments
Range(Chr$(spalte) & zeile).AddComment
Range(Chr$(spalte) & zeile).Comment.Visible = False
Resume Next
End If
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen