【问题标题】:Change font color for variable as part of text in cell将变量的字体颜色更改为单元格中文本的一部分
【发布时间】:2017-02-07 23:00:00
【问题描述】:

我正在努力使用应该为部分文本着色的 VBA 宏。

宏看起来像

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

我想实现 Now() 为红色,其余文本为绿色。

我尝试使用 .Font.Color = vbRed 等,但没有任何运气

我也在看this answer,但这不是我想要的

【问题讨论】:

    标签: vba excel


    【解决方案1】:

    试试这样:

    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
    

    我已经去掉了输入框,但是你可以很容易地把它退回来。它可能提供您想要的。几乎,它要求 Now() 格式的长度,并按照您在问题中提到的问题的逻辑将公式中的前 N ​​个符号涂成红色。

    【讨论】:

      【解决方案2】:

      您链接了一个答案,但您没有使用其中的内容,为什么?

      试试这个:

      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
      

      【讨论】:

      • 非常感谢,第一次插入效果很好,但如果我再次使用它,它将用红色标记所有文本
      • @user7410242 :这样就可以了!我添加了一行将初始颜色重置为黑色,所以它现在可以正常工作了
      【解决方案3】:

      试试这个:

      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
      

      【讨论】:

      • 非常感谢,第一次插入效果很好,但如果我再次使用它,它将用红色标记所有文本
      • @pokemon_Man : 你忘了在 If 之前删除 c.Value = "" ;)
      • @R3uK 取决于 user7410232 是否希望在每次询问输入时在同一个插入的顶部一次又一次地显示相同的插入,或者每个单元格只显示一个插入等。 IMO,我认为每个输入一个插入应该是该代码所做的方式。将单元格字符串重置为空白并再次执行颜色。
      猜你喜欢
      • 1970-01-01
      • 2012-01-04
      • 1970-01-01
      • 2014-06-18
      • 2011-12-24
      • 1970-01-01
      • 2021-03-04
      • 2016-02-21
      • 1970-01-01
      相关资源
      最近更新 更多