AW: ein Kommentar in mehrere Zellen einfügen
nighty
hi coma :)
sollte dich auch motivieren selber anzupassen :))
schlug wohl fehl :))
hier eine fertige loesung :)
gruss nighty
einzufuegen unter altf11(vbeditor)/einfuegen/modul
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