2017-02-07 15 views
5

Mam problem z makrem VBA, który powinien pokolorować część tekstu.Zmień kolor czcionki dla zmiennej jako części tekstu w komórce

Makro wygląda

Sub Note() 
     Dim c As Range 
     Dim val As String 
     Set c = ActiveCell 
     val = InputBox("Add note", "Note text") 
      If IsEmpty(c.Value) = True Then 
       c.Value = Format(Now(), "DD MMM YY Hh:Nn") & ": " & val 
      Else 
       c.Value = c.Value & Chr(10) & Format(Now(), "DD MMM YY Hh:Nn") & ": " & val 
     End If 
     End Sub 

I chcę osiągnąć Now() będzie czerwony a reszta tekstu będzie zielony.

Próbowałem grać z .Font.Color = vbRed etc ale bez powodzenia

Ja też spojrzeć na this answer ale to nie całkiem to, czego chciałem

Odpowiedz

2

Jesteś związany odpowiedź, ale nie używali co tam było, dlaczego?

Spróbuj tego:

Sub Note() 
Dim c As Range 
Dim val As String 
Dim StartChar As Integer, _ 
    LenColor As Integer 
Set c = ActiveCell 

val = InputBox("Add note", "Note text") 

With c 
    .Font.Color = RGB(0, 0, 0) 
    If IsEmpty(.Value) = True Then 
     StartChar = 1 
     LenColor = Len("DD MMM YY Hh:Nn") 
     .Value = Format(Now(), "DD MMM YY Hh:Nn") & ": " & val 
     .Characters(Start:=StartChar, Length:=LenColor).Font.Color = RGB(255, 0, 0) 
    Else 
     StartChar = Len(.Value) + 1 
     LenColor = Len("DD MMM YY Hh:Nn") 
     .Value = .Value & Chr(10) & Format(Now(), "DD MMM YY Hh:Nn") & ": " & val 
     .Characters(Start:=StartChar, Length:=LenColor).Font.Color = RGB(255, 0, 0) 
    End If 
End With 'c 
End Sub 
+0

Wielkie dzięki, działa poprawnie za pierwszym wkładem, ale jeśli mogę użyć go ponownie będzie zaznaczyć cały tekst z czerwonym – user7410242

+0

@ user7410242: Będzie to zrobić! Dodałem linię, aby zresetować początkowy kolor na czarny, więc teraz będzie działał poprawnie – R3uK

3

Spróbuj tak:

Option Explicit 

Sub Note() 

    Dim c   As Range 
    Dim val   As String: val = "vit" 
    Dim lngLen  As Long 

    Set c = ActiveCell 
    c.Value = Format(Now(), "DD MMM YY Hh:Nn") & ": " & val 
    lngLen = Len(Format(Now(), "DD MMM YY Hh:Nn")) 

    c.Characters(Start:=1, Length:=lngLen).Font.Color = vbRed 

End Sub 

usunąłem pole wejściowe, ale można go łatwo wrócić. Daje to prawdopodobnie to, czego chcesz. Bardzo dużo, prosi o długość formatu Now() i koloruje pierwsze znaki N w formule na czerwono, zgodnie z logiką z pytania, które wspomniałeś w swoim pytaniu.

1

Spróbuj tego:

Sub Note() 
Dim c As Range 
Dim val As String 
Dim lngPos As Integer 
Set c = ActiveCell 
val = InputBox("Add note", "Note text") 
c.Value = "" 
    If IsEmpty(c.Value) = True Then 
     c.Value = Format(Now(), "DD MMM YY Hh:Nn") & " - " & val 
     lngPos = InStr(ActiveCell.Value, " - ") 
     With ActiveCell.Font 
      .ColorIndex = 4 
     End With 
     With ActiveCell.Characters(Start:=1, Length:=lngPos - 1).Font 
      .ColorIndex = 3 'or .Color = RGB(255, 0, 0) 
     End With 
    Else 
     c.Value = c.Value & Chr(10) & Format(Now(), "DD MMM YY Hh:Nn") & " - " & val 
     lngPos = InStr(ActiveCell.Value, " - ") 
     With ActiveCell.Font 
      .ColorIndex = 4 
     End With 
     With ActiveCell.Characters(Start:=1, Length:=lngPos - 1).Font 
      .ColorIndex = 3 'or .Color = RGB(255, 0, 0) 
     End With 
    End If 
End Sub 
+0

Wielkie dzięki, działa dobrze dla pierwszego wkładu, ale jeśli użyję go jeszcze raz Zaznacza cały tekst na czerwono – user7410242

+0

Spróbuj edytować wpis. –

+0

@pokemon_Man: Zapomnieliście usunąć 'c.Value =" "' przed 'If';) – R3uK

Powiązane problemy