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:
1032
Rating: Antwort:
  Ja
Thema:
Inhalt Variable formatiert in Kommentar

Ich würde es allgemein so angehen:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
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