Thema Datum  Von Nutzer Rating
Antwort
27.05.2014 11:59:43 Thomas
NotSolved
27.05.2014 22:53:34 Gast86706
NotSolved
28.05.2014 11:34:17 Gast91444
NotSolved
28.05.2014 21:59:32 Gast5735
NotSolved
28.05.2014 22:37:22 Gast66671
NotSolved
Blau Inhalt Variable formatiert in Kommentar
29.05.2014 11:12:50 Gast95269
NotSolved
02.06.2014 07:53:54 Thomas
NotSolved
03.06.2014 04:50:03 Gast95269
NotSolved

Ansicht des Beitrags:
Von:
Gast95269
Datum:
29.05.2014 11:12:50
Views:
932
Rating: Antwort:
  Ja
Thema:
Inhalt Variable formatiert in Kommentar

Ich würde es allgemein so angehen:

Option Explicit

Public Sub Test()
  
  Dim rngS As Excel.Range
  Dim rngT As Excel.Range
  
  Set rngS = Range("A2") 'Beispiel
  Set rngT = Range("C2") 'Beispiel, hier wird der Kommentar gesetzt
  
'# Vorbereitung: Kommentar
  rngT.Value = "Kommentar"
  Call rngT.EntireColumn.AutoFit 'Spaltenbreite anpassen
  
'# Vorbereitung: Teil-Ausdruck (aus einer Zelle stammend)
  
  'Teil-Ausdruck für den Kommentar setzen
  rngS.Value = "Ey, hallo Du da!"
  'Ausdruck 'hallo' formatieren
  rngS.Characters(5, 6).Font.Italic = True
  'Ausdruck 'Du' formatieren
  rngS.Characters(11, 2).Font.Bold = True
  rngS.Characters(11, 2).Font.Underline = xlUnderlineStyleSingle
  Call rngS.EntireColumn.AutoFit 'Spaltenbreite anpassen
  
'# Zellen-Kommentar löschen, falls bereits einer vorhanden ist
  If Not rngT.Comment Is Nothing _
    Then Call rngT.Comment.Delete
  
'# jetzt gehts los, Kommentar zusammenbauen
  Call CommentAppend(rngT, "Überschrift", Bold:=True)
  
  Call CommentAppend(rngT, vbNewLine & Space$(3))
  Call CommentAppend(rngT, "* Punkt-1", Italic:=True)
  
  Call CommentAppend(rngT, vbNewLine & Space$(3))
  Call CommentAppend(rngT, "* Punkt-2", Bold:=True)
  
  Call CommentAppend(rngT, vbNewLine & Space$(3))
  Call CommentAppend(rngT, "* Punkt-3", Italic:=True, Underline:=xlUnderlineStyleSingle)
  
  Call CommentAppend(rngT, vbNewLine & Space$(3))
  Call CommentAppend(rngT, "* Punkt-4", Bold:=True, Italic:=True, Underline:=xlUnderlineStyleDouble)
  
  Call CommentAppend(rngT, vbNewLine & vbNewLine)
  Call CommentAppend(rngT, rngS) '<- als Quelle dient hier ein Zellenbereich und dessen Formatierung
'  ODER z.B.
'   ' * ohne Formatierung 'Fett' zu berücksichtigen
'  Call CommentAppend(rngT, rngS, Bold:=False)
'   ' * ohne Formatierung 'Fett' und 'Unterschtrichen' zu berücksichtigen
'  Call CommentAppend(rngT, rngS, Bold:=False, Underline:=False)
  
  
'# Kommentar noch in seiner Größe passend dimensionieren
  rngT.Comment.Shape.TextFrame.AutoSize = True
  
End Sub

'////////////////////////////////////////////////////////////////
'// die "tolle" Hilfsfunktion
Public Sub CommentAppend( _
    Target As Excel.Range, _
    Source As Variant, _
    Optional ByVal Bold As Variant, _
    Optional ByVal Italic As Variant, _
    Optional ByVal Underline As Variant _
)
  Const ERR_INVALID_ARG As Long = 5
  
  Dim rngSrc As Excel.Range
  Dim lngLenPrev As Long
  
  If IsObject(Source) Then
    
    If Source Is Nothing Then
      Call Err.Raise(ERR_INVALID_ARG)
    ElseIf TypeOf Source Is Excel.Range Then
      If Source.Cells.Count = 1 Then
        If IsMissing(Bold) Then Bold = True             'Default: ja, übernehmen
        If IsMissing(Italic) Then Italic = True         'Default: ja, übernehmen
        If IsMissing(Underline) Then Underline = True   'Default: ja, übernehmen
        Set rngSrc = Source
        Call CommentAppendR(Target, rngSrc, CBool(Bold), CBool(Italic), CBool(Underline))
      Else
        Call Err.Raise(ERR_INVALID_ARG)
      End If
    Else
      Call Err.Raise(ERR_INVALID_ARG)
    End If
    
  Else 'einfach formatierten Text hinzufügen
    
    If Target.Comment Is Nothing Then
      Call Target.AddComment(Text:=CStr(Source))
    Else
      lngLenPrev = Len(Target.Comment.Text)
      Call Target.Comment.Text(Text:=CStr(Source), Start:=lngLenPrev + 1)
    End If
    
    With Target.Comment.Shape.TextFrame.Characters(lngLenPrev + 1, Len(CStr(Source))).Font
      .Underline = IIf(IsMissing(Underline), xlUnderlineStyleNone, CLng(Underline))
      .Italic = IIf(IsMissing(Italic), False, CBool(Italic))
      .Bold = IIf(IsMissing(Bold), False, CBool(Bold))
    End With
    
  End If
  
End Sub

'////////////////////////////////////////////////////////////////
'// Hilfsfunktion (Range-Version)
'//  !! diese nicht selbst aufrufen !! - wird über "CommentAppend" ausgeführt
Private Sub CommentAppendR( _
    Target As Excel.Range, _
    Source As Excel.Range, _
    ApplyBold As Boolean, _
    ApplyItalic As Boolean, _
    ApplyUnderline As Boolean _
)
  Dim objCharSrc As Excel.Characters
  Dim lngLenPrev As Long
  Dim i As Long
  
  If Target.Comment Is Nothing Then
    Call Target.AddComment(Text:=Source.Text)
  Else
    lngLenPrev = Len(Target.Comment.Text)
    Call Target.Comment.Text(Text:=Source.Text, Start:=lngLenPrev + 1)
  End If
  
  With Target.Comment.Shape.TextFrame
    'nachfolgender Ablauf ist noch optimierbar
    For i = 1 To Source.Characters.Count
      Set objCharSrc = Source.Characters(i, 1)
      With .Characters(lngLenPrev + i, 1).Font
        .Underline = IIf(ApplyUnderline, objCharSrc.Font.Underline, xlUnderlineStyleNone)
        .Italic = IIf(ApplyItalic, objCharSrc.Font.Italic, False)
        .Bold = IIf(ApplyBold, objCharSrc.Font.Bold, False)
      End With
    Next
  End With
  
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
27.05.2014 11:59:43 Thomas
NotSolved
27.05.2014 22:53:34 Gast86706
NotSolved
28.05.2014 11:34:17 Gast91444
NotSolved
28.05.2014 21:59:32 Gast5735
NotSolved
28.05.2014 22:37:22 Gast66671
NotSolved
Blau Inhalt Variable formatiert in Kommentar
29.05.2014 11:12:50 Gast95269
NotSolved
02.06.2014 07:53:54 Thomas
NotSolved
03.06.2014 04:50:03 Gast95269
NotSolved