セル内テキストのフォント色を途中で変更※セル内改行を考慮

' ----------------------------------------------------------------
' 選択されたセル内のテキストに対し、フォント色を変更する処理
'（「:」の前後でフォント色を変更 ※セル内改行を考慮）
' ----------------------------------------------------------------
Sub prcFormatTextInCellLines()
    Dim rngCell As Range          ' 処理するセルを参照するための変数
    Dim arrLines() As String      ' セル内の各行を格納するための配列
    Dim intLineIndex As Integer   ' 行のインデックス
    Dim intStartPos As Integer    ' フォーマット開始位置
    Dim intColonPos As Integer    ' コロンの位置
    Dim lngGrayColor As Long      ' グレー色を表すLong型の数値
    Dim lngBlackColor As Long     ' 黒色を表すLong型の数値

    lngGrayColor = &H808080       ' グレー色のLong型の十進数値
    lngBlackColor = &H0           ' 黒色のLong型の十進数値

    ' 選択範囲内の各セルに対してループ処理
    For Each rngCell In Selection
        If InStr(rngCell.Text, Chr(10)) Then
            arrLines = Split(rngCell.Text, Chr(10)) ' セル内のテキストを行ごとに分割
            intStartPos = 1

            ' 各行に対してループ処理
            For intLineIndex = LBound(arrLines) To UBound(arrLines)
                intColonPos = InStr(arrLines(intLineIndex), "：") ' コロンの位置を検索
                If intColonPos > 0 Then
                    ' コロンの前のテキストをグレーに設定
                    With rngCell.Characters(Start:=intStartPos, Length:=intColonPos).Font
                        .Color = lngGrayColor
                    End With
                    ' コロンの後のテキストを黒に設定
                    With rngCell.Characters(Start:=intStartPos + intColonPos + 1, Length:=Len(arrLines(intLineIndex)) - intColonPos).Font
                        .Color = lngBlackColor
                    End With
                End If
                intStartPos = intStartPos + Len(arrLines(intLineIndex)) + 1 ' 次の行の開始位置を更新
            Next intLineIndex
        End If
    Next rngCell
End Sub

コメント