Funktion anpassen

Public Function Tooltip(rngZelleFürTooltip As Range, rngTextFürToolTip As Range) As String Dim c As Comment If rngZelleFürTooltip.Comment Is Nothing Then Set c = rngZelleFürTooltip.AddComment Else Set c = rngZelleFürTooltip.Comment End If c.Text rngTextFürToolTip.Text & " " & Chr(10) & "Test" Set c = Nothing End Function

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Code:

Public Function TooltipNeu(rngTextFürToolTip As Range) As String
  Dim c As Comment, rRng As Range, sText As String
  
  If Application.ThisCell.Comment Is Nothing Then
     Set c = Application.ThisCell.AddComment
  Else
     Set c = Application.ThisCell.Comment
  End If
  For Each rRng In rngTextFürToolTip
      sText = sText & rRng.Value & vbLf
  Next rRng
  c.Text Left$(sText, Len(sText) - 1)
End Function

Hallo Thomas,
ich habe rumbasteln müssen, um erst das Coding von Volti zu verstehen :-)
Nicht = TooltipNeu(B3;B4;B5)
sondern =TooltipNeu(B3:B5)
Ich habe erweitert mit der Möglichkeit, einen anderen Trennzeichen als Linefeed optional eingeben zu können

Public Function TooltipNeu(ByVal QuellZellen As Range, Optional Trennzeichen As String = vbLf) As String
'Auf Basis eines Codings von Volti
Dim rRng As Range
Dim sText As String
  
    For Each rRng In rngTextFürToolTip
        sText = sText & Trennzeichen & rRng.Value
    Next rRng
    With Application.ThisCell
        If .Comment Is Nothing Then .AddComment
        .Comment.Text Mid(sText, Len(Trennzeichen) + 1)
    End With
    TooltipNeu = Mid(sText, Len(Trennzeichen) + 1) 'Kommentar wird als Formelergebnis angezeigt
End Function

Zum Beispiel
= TooltipNeu (B3:B5)
= TooltipNeu (B3:B5; " | ")
= TooltipNeu ( B3:B5; " => ")
Möchtest Du aber die Zellen einzel eingeben, egal wieviel (Trennzeichen muss dann zuerst eingegeben werden):

Public Function TooltipEinzel(ByVal Trennzeichen As String, ParamArray Quellen()) As String
'Auf Basis eines Codings von Volti
Dim Msg As String
Dim E
    
    For Each E In Quellen
        Msg = Msg & Trennzeichen & CStr(E)
    Next
    With Application.ThisCell
        If .Comment Is Nothing Then .AddComment
        .Comment.Text Mid(Msg, Len(Trennzeichen) + 1) 'ohne führende Leerzeichen
    End With
    TooltipEinzel = Mid(sText, Len(Trennzeichen) + 1) 'Kommentar wird als Formelergebnis angezeigt
End Function

=TooltipEinzel(" ";B3;B4;B5)
=TooltipEinzel(" ";B3;B5;B4;C15)
=TooltipEinzel(" ";B3;"ist besser als";B5;":-p") sollte auch gehen.
Eine Version mit festem Trennzeichen:

Public Function TooltipEinzel(ParamArray Quellen()) As String
'Auf Basis eines Codings von Volti
Dim Msg As String
Dim E
Const Trennzeichen = " " 'Leerzeichen. Man kann aber es ändern
    
    For Each E In Quellen
        Msg = Msg & Trennzeichen & CStr(E)
    Next
    With Application.ThisCell
        If .Comment Is Nothing Then .AddComment
        .Comment.Text Mid(Msg, Len(Trennzeichen) + 1) 'ohne führende Leerzeichen
    End With
    TooltipEinzel = Mid(sText, Len(Trennzeichen) + 1) 'Kommentar wird als Formelergebnis angezeigt
End Function

=TooltipEinzel(B3;B4;B5)
=TooltipEinzel(B3;"ist besser als";B5) sollte auch gehen.
Es überschreibt den bisherigen Kommentar. Möchtest Du "hinzufügen", brauchst Du

Public Function Kommentar(ByVal QuellZelle As Range) As String
    Kommentar = QuellZelle.Comment.Text
End Function

in B3 als =Kommentar(B2)
VG
Yal

Public Function TooltipNeu(ByVal QuellZellen As Range, Optional Trennzeichen As String = vbLf) As String 'Auf Basis eines Codings von Volti Dim rRng As Range Dim sText As String For Each rRng In QuellZellen '- hier hat's gescheppert sText = sText & Trennzeichen & rRng.Value Next rRng With Application.ThisCell If .Comment Is Nothing Then .AddComment .Comment.Text Mid(sText, Len(Trennzeichen) + 1) End With TooltipNeu = Mid(sText, Len(Trennzeichen) + 1) 'Kommentar wird als Formelergebnis angezeigt End Function

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread