セル内の文字色や太字をfont color=”#FF0000″のようにHTML化する

isakat

5年前

文字に色を付けていたり、太字にしたものを判別し、それをHTMLタグ化するVBAを作成しました。

セル内に複数の文字色や太字部分が複数あっても問題なくHTML化します。

VBAコード

Dim Red As String
Dim Green As String
Dim Blue As String
Dim cRange As Range
Dim moji As String
Dim moji2 As String

Sub HTML_Change()
    For Each cRange In Selection
    moji = ""
    y = 1
        For i = 1 To Len(cRange)
            If cRange.Characters(Start:=i, Length:=1).Font.Color <> RGB(0, 0, 0) Then
                moji2 = BoldCHK(y, i - 1)
                moji = moji & moji2
                iLen = 1
                Do Until cRange.Characters(Start:=i, Length:=1).Font.Color <> cRange.Characters(Start:=i + iLen, Length:=1).Font.Color
                    iLen = iLen + 1
                Loop
                Call GetRGBValue(cRange.Characters(Start:=i, Length:=1).Font.Color, Red, Green, Blue)
                moji = moji & "<font color=""#" & Red & Green & Blue & """>"
                moji2 = BoldCHK(i, i + iLen - 1)
                moji = moji & moji2
                moji = moji & "</font>"
                i = i + iLen - 1
                y = i + 1
            End If
        Next
        If i <> y Then
            moji2 = BoldCHK(y, i - 1)
            moji = moji & moji2
        End If
    cRange.Value = moji
    Next cRange
End Sub

Function BoldCHK(st, en) As String
    BoldCHK = ""
    chky = st
    For chk = st To en
        If cRange.Characters(Start:=chk, Length:=1).Font.Bold = True Then
            BoldCHK = BoldCHK & cRange.Characters(Start:=chky, Length:=chk - chky).Text
            iLen = 1
            Do Until cRange.Characters(Start:=chk, Length:=1).Font.Bold <> cRange.Characters(Start:=chk + iLen, Length:=1).Font.Bold
                If st + iLen - 1 = en Then
                    Exit Do
                End If
                iLen = iLen + 1
            Loop
            BoldCHK = BoldCHK & "<B>" & cRange.Characters(Start:=chk, Length:=iLen).Text & "</B>"
            chk = chk + iLen - 1
            chky = chk + 1
        End If
    Next
    If chk <> chky Then
        BoldCHK = BoldCHK & cRange.Characters(Start:=chky, Length:=chk - chky).Text
        
    End If
End Function

Sub GetRGBValue(lColorValue, Red, Green, Blue)
    Red = Format(Hex(lColorValue Mod 256), "00")
    Green = Format(Hex(Int(lColorValue / 256) Mod 256), "00")
    Blue = Format(Hex(Int(lColorValue / 256 / 256)), "00")
End Sub

使い方

上記のコードを標準モジュールに貼り付けしてください。

HTML_Changeを走らせると、選択したセル（範囲OK）の文字色と太字をHTML化させます。

文字色はRGBで表現しますので何色でも問題ありません。黒（標準）の場合は特に何もしません。

コードの説明

一文字ずつ文字色をチェック
黒以外なら、その後何文字後まで同色か？
その文字列を<font color=”#FF0000″>～～</font>で囲む
太字<B>も同様に一文字ずつチェック

流れはこんな感じです。

あと細かいコードの説明としては

Charactersプロパティ

cRange.Characters(Start:=i, Length:=1)

これがセル内の一文字ずつ見る方法ですね。
Charactersプロパティは、セルに入力された文字列の一部を参照することが出来ます。セルに入力された文字列の何文字目（Start）から何文字（Length）分の文字を表せますが、セル内に数値や数式が入っているとエラーを返します。空白はOK。

構文　Object.Characters(Start, Length)

設定項目	内容
Object	Rangeオブジェクト
Start	参照したい文字列の先頭位置を指定します。省略した場合は1
Length	参照したい文字数を指定します。省略した場合はStart以降の全文字列

参照するだけでなく、指定した部分に別の文字を設定する事もできます。
あいうえお　→（３文字目を”ん”にしたい）　あいんえお　のように。

A1に「あいうえお」が入っていた場合。

Range("A1").Characters(3, 1).Text = "ん"

A1セルの３文字目から１文字だけを”ん”に変更します。

テキストだけでなく文字装飾も出来るのでこれを活用し、以下のようなコードにすれば文字の色を判別できます。

For i = 1 To Len(cRange)
    If cRange.Characters(Start:=i, Length:=1).Font.Color <> RGB(0, 0, 0) Then

Colorプロパティ

また、ややこしいのがColorプロパティです。

Colorプロパティはオブジェクトに応じて適用する色を設定します。色は、RGB関数によって作成された値です。

で、RGB関数とは

色のRGB値を表す長整数型 (Long) の値を返します。
構文
RGB(red, green, blue)
red：RGBのR(赤)の割合を0～255の整数で指定します
green：RGBのG(緑)
の割合を0～255の整数で指定します
blue：RGBのB(青)
の割合を0～255の整数で指定します
Excelヘルプ

R×256　+　G×256　+　B×256×256　という計算の結果の数値で表しています。
紫でしたら「112＋48×256＋160×256×256」で「10498160」となります。

ですのでHTMLの文字色にする場合、16進数の”#FF0000″のように置き換える必要があります。そこで以下のコードとしています。

Sub GetRGBValue(lColorValue, Red, Green, Blue)
    Red = Format(Hex(lColorValue Mod 256), "00")
    Green = Format(Hex(Int(lColorValue / 256) Mod 256), "00")
    Blue = Format(Hex(Int(lColorValue / 256 / 256)), "00")
End Sub