Office: automatisch Kommentar einfügen mithilfe von Makros

Hallo,

ich habe bereits einen Urlaubsplan erstellt, bei dem ich mithilfe von Makros automatisch geplante Urlaubstage eintragen kann.
(Ich drücke auf den Button "Urlaub beantragt" es erscheint in der ausgewählten Zelle statt bisher einer 1 ein U und die Zellenfarbe wird gelb)

Nun möchte ich diese Funktion erweitrn:

Wenn ich den Button "Urlaub beantragt" klicke soll nun auch noch automatisch ein Kommentar eingefügt werden, in dem der Text
"Urlaub beantragt am (aktuelles Datum)" steht.
Wennn es möglich ist, wäre es auch noch super wenn der Username mit eingefügt wird, da der Urlaubsplan von mehreren Usern benutzt wird.

Schonmal im Voraus Vielen Dank :-D

 

Hi,

Code:

Sub KommentarAendern()
'    ActiveSheet.Unprotect
    With ActiveCell
        If Not .Comment Is Nothing Then
            .Comment.Text .Comment.Text & vbLf & "Urlaub beantragt " & Date & " " & Environ("Username")
        Else
            .AddComment "Urlaub beantragt " & Date & " " & Environ("Username")
        End If
        .Comment.Shape.DrawingObject.AutoSize = True
    End With
'    ActiveSheet.Protect
End Sub

Bis später,
Karin

 

Danke :-D

funktioniert einwanfrei...

Was muss ich denn noch ändern wenn der Username "Fett" geschrieben werden soll?

Kann mir denn jemand sagen wo ich mir das alles auch selber beibringen kann? Interessiere mich sehr dafür, hab aber leider noch nirgends etwas gefunden wo ich es lernen kann.

 

Hi,

für die Fett-Formatierung von Kommentarteilen per Code ist mir keine Lösung bekannt.

Wenn du VBA lernen möchtest, könnte das vielleicht ein Anfang sein: ftp://ftp.fernuni-hagen.de/pub/pdf/urz-broschueren/broschueren/b0049807.pdf. Die beste Schule ist jedoch folgende: lies im Forum die Beiträge mit VBA-Lösungen und baue Beispiele nach.

Bis später,
Karin

 

Hallo,

folgender Code stellt die User fett dar mit vergrößerter Schrift (15 Pt); auch mehrere Userzeilen müssten korrekt widergegeben werden:

Code:

Sub KommentarAendern()
    Dim Txt$  'Gesamter Kommentartext
    Dim PsU&  'Zeichenpos. der Usernamenanfänge
    Dim ZlTxt$() 'Array der Kommentarzeilen
    Dim Zl&, LgT&
'    ActiveSheet.Unprotect
    With ActiveCell
        If .Comment Is Nothing Then .AddComment ""
        With .Comment
          If Len(.Text) Then .Text .Text & vbCrLf
          .Text .Text & "Urlaub beantragt " & Date & " " & Environ("Username")
          Txt$ = .Text
          ZlTxt$ = Split(Txt$, vbCrLf)
          With .Shape
              .AutoShapeType = 1                    'Rechteck
              .Fill.ForeColor.RGB = RGB(255, 0, 0)  'roter Hintergrund
              With .TextFrame
                  .AutoSize = True            'autom.Größenanpassung (des Rechtecks)
                  LgT& = -2
                  For Zl& = 0 To UBound(ZlTxt$)
                    LgT& = LgT& + 2 + Len(ZlTxt$(Zl&))
                    PsU& = InStrRev(Left$(Txt$, LgT&), " ")
                    With .Characters(PsU& + 1, LgT& - PsU&).Font
                      .Size = 15
                      .Bold = -1
                    End With
                  Next Zl&
              End With 'TextFrame
          End With 'Shape
        End With 'Comment
    End With 'ActiveCell
'    ActiveSheet.Protect
End Sub

 

Hallo,

ich habe erst im Nachhinein festgestellt, dass mein voriges Makro nur unter Excel2007 ohne Schönheitsfehler funktioniert (kein leeres Kästchen am Zeilenende des Kommentars bei mehrzeiligen Kommentaren). In Excel2003 darf man offenbar am Kommentarzeilenende nur vbLf als Zeilenumbruchzeichen verwenden (mit einer Zeichenlänge 1). Dafür darf man in Excel2003 beim Kommentar-Font auch die Color-Eigenschaft verwenden (in Excel2007 ist selbst im SP2 noch ein Bug enthalten, der die Verwendung der Color-Eigenschaft beim Kommentar-Font verunmöglicht).

Code:

Sub KommentarAendern() 
    Dim Txt$  'Gesamter Kommentartext 
    Dim PsU&  'Zeichenpos. der Usernamenanfänge 
    Dim ZlTxt$() 'Array der Kommentarzeilen 
    Dim Zl&, LgT& 
'    ActiveSheet.Unprotect 
    With ActiveCell 
        If .Comment Is Nothing Then .AddComment "" 
        With .Comment 
          If Len(.Text) Then .Text .Text & vbLf 
          .Text .Text & "Urlaub beantragt " & Date & " " & Environ("Username") 
          Txt$ = .Text 
          ZlTxt$ = Split(Txt$, vbLf) 
          With .Shape 
              .AutoShapeType = 1                    'Rechteck 
              .Fill.ForeColor.RGB = RGB(255, 0, 0)  'roter Hintergrund 
              With .TextFrame 
                  .AutoSize = True            'autom.Größenanpassung (des Rechtecks) 
                  LgT& = -1 
                  For Zl& = 0 To UBound(ZlTxt$) 
                    LgT& = LgT& + 1 + Len(ZlTxt$(Zl&)) 
                    PsU& = InStrRev(Left$(Txt$, LgT&), " ") 
                    With .Characters(PsU& + 1, LgT& - PsU&).Font 
                      .Size = 15                'Zeichengröße 15 Punkt
                      .Bold = -1                'Zeichen fett
                     '.Color = RGB(0,0,255)     'Zeichen in blauer Farbe
                    End With 
                  Next Zl& 
              End With 'TextFrame 
          End With 'Shape 
        End With 'Comment 
    End With 'ActiveCell 
'    ActiveSheet.Protect 
End Sub

 

Funktioniert soweit wunderbar.
Jetzt wär es nur noch super wenn der Username am anfag steht. Habe selbst versucht den Code umzuschreiben, was zu keinem Erfolg geführt hat. Die Anordnung hab ich hinbekommen, aber dann war entweder alles oder nichts Fett geschrieben...

 

Hallo,

ich habe im folgenden Makro Deinen Wünschen gemäß den User innerhalb der Kommentarzeile umgestellt. Dabei wird der User größer (15 Pt) und fett geschrieben, die restliche Zeile kleiner (8 Pt) und mager.

Code:

Sub KommentarAendern()
    Dim Txt$         'Gesamter Kommentartext
    Dim LgT&, LgU&   'Zeichenpos. innerhalb von Txt$
    Dim ZlTxt$()     'Array der Kommentarzeilen
    Dim Zl&          'Zeilenindex
'    ActiveSheet.Unprotect
    With ActiveCell
        If .Comment Is Nothing Then .AddComment ""
        With .Comment
          If Len(.Text) Then .Text .Text & vbLf
          .Text .Text & Environ("Username") & ": " & "Urlaub beantragt " & Date
          Txt$ = .Text
          ZlTxt$ = Split(Txt$, vbLf)
          With .Shape
              .AutoShapeType = 1                    'Rechteck
              .Fill.ForeColor.RGB = RGB(255, 0, 0)  'roter Hintergrund
              With .TextFrame
                  .AutoSize = True            'autom.Größenanpassung (des Rechtecks)
                  LgT& = 0 ' -1
                  For Zl& = 0 To UBound(ZlTxt$)
                    LgT& = LgT& + 1
                    LgU& = InStr(LgT&, Txt$, ": ") + 1
                    With .Characters(LgT&, LgU& - LgT&).Font
                      .Size = 15                'Zeichengröße 15 Punkt
                      .Bold = -1                'Zeichen fett
                     '.Color = RGB(0,255,0)     'Zeichen in grüner Farbe
                    End With
                    LgT& = LgT& + Len(ZlTxt$(Zl&))
                    With .Characters(LgU&, LgT& - LgU&).Font
                      .Size = 8                 'Zeichengröße 8 Punkt
                      .Bold = 0                 'Zeichen mager
                     '.Color = RGB(0,0,255)     'Zeichen in blauer Farbe
                    End With
                  Next Zl&
              End With 'TextFrame
          End With 'Shape
        End With 'Comment
    End With 'ActiveCell
'    ActiveSheet.Protect
End Sub

 

Besten Dank.
Funktioniert einwanfrei