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

更改附加文字的颜色？

2 个答案: