更改附加的文本颜色？

Question

我将通过将 MS Project 任务信息相互附加来生成一些大的 excel 单元格值，然后我将计算某个任务自上次报告以来是否发生了变化。我只需要为单元格中更改的任务着色，但它会在一个包含许多其他任务的长字符串中。如果我可以在添加任务时更改任务的颜色，那就太好了。

我想我必须使用某种 'With' 语句，但我不知道从哪里开始。

With cell
    .FutureFormat red
    .Value = .Value & "abc"
End With

或者类似

Stringthing = "ABC"
Stringthing.Format = red
Cell.value = cell.value & Stringthing

Answer 1

这是一个示例代码：

Option Explicit

Public Sub AppendStringAndColorize()
    Dim str As String
    str = "abc"

    Dim cell As Range
    Set cell = Range("A1")

    Dim CellLength As Long
    CellLength = Len(cell.Value)

    With cell
        .Value = .Value & str
        .Characters(Start:=CellLength + 1, Length:=Len(str)).Font.Color = vbRed
    End With
End Sub

您首先需要记住原始值的长度作为起点，以便为该值之后的字符着色。

要保留旧颜色：

Public Sub AppendStringAndColorizeKeepingOldColors()
    Dim str As String
    str = "abc"

    Dim cell As Range
    Set cell = Range("A1")

    Dim CharList() As Variant
    Dim CurrentColor As Double
    CurrentColor = cell.Characters(1, 1).Font.Color

    Dim iColor As Long 'color change counter
    iColor = 1
    ReDim CharList(1 To 2, 1 To 1) As Variant
    CharList(1, iColor) = CurrentColor

    Dim CellLength As Long
    CellLength = cell.Characters.Count

    'analyze colors and save into array
    Dim i As Long
    For i = 1 To CellLength
        If cell.Characters(i, 1).Font.Color <> CurrentColor Then
            CurrentColor = cell.Characters(i, 1).Font.Color
            iColor = iColor + 1
            ReDim Preserve CharList(1 To 2, 1 To iColor)
            CharList(1, iColor) = CurrentColor
        End If
        CharList(2, iColor) = CharList(2, iColor) + 1
    Next i

    'change cell value (append only!)
    cell.Value = cell.Value & str

    're-write colors
    Dim ActChar As Long
    ActChar = 1
    For i = LBound(CharList) To UBound(CharList, 2)
        cell.Characters(Start:=ActChar, Length:=CharList(2, i)).Font.Color = CharList(1, i)
        ActChar = ActChar + CharList(2, i)
    Next i

    'color for new appended string
    cell.Characters(Start:=CellLength + 1, Length:=Len(str)).Font.Color = vbYellow 'desired color

End Sub

Answer 2

以下是在不影响现有格式的情况下添加新文本的方法。

注意： 这种方法只适用于总长度不超过 250 个字符的情况。不确定你达到那个点后是否有任何办法。

Public Sub Tester()
    Const NUM As Long = 20
    Const TXT As String = "The quick brown for jumped over the lazy dogs"

    Dim colors, i, l

    colors = Array(vbRed, vbBlue)

    With ActiveSheet.Range("A1")

        For i = 1 To NUM
            l = Len(.Value)
            'Error here if trying to access characters after ~250     
            With .Characters(Start:=l + 1, Length:=Len(TXT) + 1)
                .Text = TXT & vbLf
                .Font.Color = colors(i Mod 2)
            End With
        Next i

    End With

End Sub

更改附加的文本颜色？

Change text color as it's appended?

excel

vba

ms-project