+ Reply to Thread
Results 1 to 2 of 2

Newby Needs minor tweak on this VBA Macro code for Excel

  1. #1
    zulfer7
    Guest

    Newby Needs minor tweak on this VBA Macro code for Excel

    bgeier did a lot to this code, it works perfectly now except for that the
    comments don't add to an existing comment, they seem to be overwriting the
    existing comment. Please help, this code will be used in a major application
    for my company but cannot be used if I cannot get it to function. PLEASE
    HELP!

    Sub KeyCellsChanged()
    Dim strDate As String
    Dim cmt As Comment
    Dim Username As String
    Dim lName As Long

    strDate = "ddmmmyy hh:mm"
    Username = application.Username
    Set cmt = ActiveCell.Comment
    lName = 0

    If cmt Is Nothing Then
    Set cmt = ActiveCell.AddComment
    With cmt
    ..Text (Username & " " & Format(Now, strDate) & Chr(10))
    ..Shape.TextFrame.Characters(1, Len(Username)).Font.Bold = True
    End With
    Else
    Set cmt = ActiveCell.Comment
    With cmt
    ..Shape.TextFrame.Characters(1, Len(cmt.Text)).Font.Bold = False
    ..Text ("")
    ..Text (Username)
    ..Shape.TextFrame.Characters(1, Len(Username)).Font.Bold = True
    ..Text (cmt.Text & " " & Chr(10) & Format(Now, strDate))
    ..Shape.TextFrame.Characters(Len(Username) + 1, Len(strDate) + 2).Font.Bold =
    False
    End With
    End If
    End Sub

  2. #2
    Jim Cone
    Guest

    Re: Newby Needs minor tweak on this VBA Macro code for Excel

    Jim Cone
    San Francisco, USA
    http://www.realezsites.com/bus/primitivesoftware

    Sub KeyCellsChanged()
    Dim strDate As String
    Dim cmt As Excel.Comment
    Dim Username As String
    Dim lngLen As Long

    strDate = "ddmmmyy hh:mm"
    Username = Application.Username
    Set cmt = ActiveCell.Comment

    If cmt Is Nothing Then
    Set cmt = ActiveCell.AddComment
    With cmt
    .Text (Username & " " & Format(Now, strDate) & Chr(10))
    .Shape.TextFrame.Characters(1, Len(Username)).Font.Bold = True
    End With
    Else
    With cmt
    lngLen = Len(.Text)
    .Shape.TextFrame.Characters(1, lngLen).Font.Bold = False
    .Text Username, lngLen + 1
    .Shape.TextFrame.Characters(lngLen + 1, 999).Font.Bold = True
    lngLen = Len(.Text) + 1
    .Text " " & Chr(10) & Format(Now, strDate) & Chr(10), lngLen
    .Shape.TextFrame.Characters(lngLen, 999).Font.Bold = False
    End With
    End If
    End Sub
    '-------------



    "zulfer7" <[email protected]>
    wrote in message
    bgeier did a lot to this code, it works perfectly now except for that the
    comments don't add to an existing comment, they seem to be overwriting the
    existing comment. Please help, this code will be used in a major application
    for my company but cannot be used if I cannot get it to function. PLEASE
    HELP!

    Sub KeyCellsChanged()
    Dim strDate As String
    Dim cmt As Comment
    Dim Username As String
    Dim lName As Long

    strDate = "ddmmmyy hh:mm"
    Username = application.Username
    Set cmt = ActiveCell.Comment
    lName = 0

    If cmt Is Nothing Then
    Set cmt = ActiveCell.AddComment
    With cmt
    ..Text (Username & " " & Format(Now, strDate) & Chr(10))
    ..Shape.TextFrame.Characters(1, Len(Username)).Font.Bold = True
    End With
    Else
    Set cmt = ActiveCell.Comment
    With cmt
    ..Shape.TextFrame.Characters(1, Len(cmt.Text)).Font.Bold = False
    ..Text ("")
    ..Text (Username)
    ..Shape.TextFrame.Characters(1, Len(Username)).Font.Bold = True
    ..Text (cmt.Text & " " & Chr(10) & Format(Now, strDate))
    ..Shape.TextFrame.Characters(Len(Username) + 1, Len(strDate) + 2).Font.Bold =
    False
    End With
    End If
    End Sub

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1