1

I have the following code which handles a double click event on one of my columns. Basically its a Notes Column so when the user double clicks it... it pops up an input and prompts for the note. The VBA code then appends a date and inserts it into the cell. I wanted the Dates to be in Bold.

However when I first enter a comment the cell is correct. Like this

23/08/2013: Hi there

when I double click the cell again and enter 'Hi again' the whole cell goes bold

23/08/2013: Hi there

23/08/2013: Hi again

I think this is because I am resetting the entire cell text and not appending to the orginal text.. hence losing the orginal formatting.

Can anyone shed any ideas on this. The only way I reckoned I could get it to work would be to look through and find the ctrl(10) char and format it that way but its way over the top.

regards D

Option Explicit

Const STATUS_COL As Integer = 10
Const NOTES_COL As Integer = 13

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim newVal As String
Dim strNote As String
Dim lngPos As Long

If Target.Count > 1 Then GoTo exitHandler

Application.EnableEvents = False

On Error Resume Next

 If Target.Column = NOTES_COL Then 'Add a note
    lngPos = Len(Target.Value)

    strNote = InputBox(Prompt:="Enter Note", _
      Title:="Notes", Default:="")

    If (Len(Trim(strNote)) > 0) Then
        If Target.Value = "" Then
          newVal = Date & ": " & strNote
        Else
          newVal = Target.Value + Chr(10) & Date & ": " & strNote
        End If
        Target.Value = newVal     'set the new value

        Target.Characters(Start:=lngPos + 1, Length:=11).Font.Bold = True
    End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub
4

1 回答 1

2 
Sub tester()
    AddNote ActiveSheet.Range("A1"), "hello"
    AddNote ActiveSheet.Range("A1"), "world"
End Sub


Sub AddNote(rng As Range, txt As String)
    Dim l As Long, s As String
    l = Len(rng.Value)
    s = IIf(l > 0, Chr(10), "") & Format(Date, "mm/dd/yyyy") & ": " & txt
    rng.Characters(l + 1, Len(s)).Text = s
    rng.Characters(l + 1, 11).Font.Bold = True
End Sub
于 2013-08-26T17:39:07.820 回答