三流君 ken3のmemo置き場

メモ置き場、保管庫として利用。まとまっていませんがヨロシク

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]


Excel VBA A列から .Charactersで Font 色や太字を判断してHTMLタグを作成する

前回、Excel A列から文字の色や太字を判断して、HTMLタグを追加する。
そんなVBAをライブで作成して、
マクロ記録で太字のFont.Boldを探せなかったり、
追加したタグがクロスしてしまうバグ・不具合を発見しました。

いつものデバッグ風景です。ライブは怖いので録画で ぉぃぉぃ。
https://www.youtube.com/watch?v=V7ZTH8ymryU
www.youtube.com
※録画なのに↑失敗してます・・・だめだこりゃ・・・

1.太字の判断
太字・強調表示の判断は
Font.Bold = True/False で判断可能です。
これは、別の動画で解決しました。※今回は説明をはぶきます。
Boldで太字・強調のテスト動画: https://www.youtube.com/watch?v=_SP__GgVwiY

2.追加したタグがクロスしてしまうバグ
文字の修飾を重ねた場合、
下記の例題では、修正の文字を青色で強調表示と重ねて指定したところ、

誤)午後に<font color=#0000FF><B>修正</font></B>したので、<BR>
                          ↑ここが、↓のようにしないと
正)午後に<font color=#0000FF><B>修正</B></font>したので、<BR>

上記のように、タグを閉じる /閉じタグ の順番がおかしかったです。

これをデバッグしてみます。

Option Explicit

Sub test20181219セルの装飾をHTMLタグ()

    Dim y As Integer
    Dim n As Integer
    
    'With ActiveCell.Characters(Start:=11, Length:=5).Font
    
    Dim strMOJI As String  '現在の一文字取り出し保存するため
    Dim lngRGB As Long     '現在のカラー番号を覚える
    Dim bBOLD  As Boolean  '現在の太字の状態を覚える
    
    Dim motoCOLOR As Long   '元の色※一つ前の文字
    Dim motoBOLD As Boolean '元の状態"太字"BOLD
    
    Dim flgFONT As String  'HTMLタグを出力中 ON:出力中 OFF:タグは無し
    Dim flgB As String     'ON:Bタグ出力中 OFF:タグ出力は無し
    
    '色を作る、細工用
    Dim strRGB As String
    Dim strR As String
    Dim strG As String
    Dim strB As String
    
    Dim strHTML As String  '出力結果
    strHTML = ""
    
    'テストで一行目から5行目までループ
    For y = 1 To 5
        Debug.Print Cells(y, "A")
        '行単位で処理します
        motoCOLOR = 0     '元の色と太字などをクリアする
        motoBOLD = False
        
        flgFONT = "OFF"  '初期値はタグが無いのでOFF
        flgB = "OFF"
        
        'ここから一文字単位で色と太字を探る
        For n = 1 To Cells(y, "A").Characters.Count  '文字のループ
            With Cells(y, "A").Characters(Start:=n, Length:=1)
                strMOJI = .Text
                lngRGB = .Font.Color
                bBOLD = .Font.Bold
            End With
            
            Debug.Print strMOJI & " Color=" & lngRGB & " Bold=" & bBOLD
        
        'タグ開始
            '色が変化したら、FONTタグを作る
            If motoCOLOR <> lngRGB Then
                If flgFONT = "OFF" Then  'OFFの時、開始しないといけない
                    'RGBを作る  RとBが逆?あとで確認
                    strRGB = Right("000000" & Hex(lngRGB), 6)
                    strR = Mid(strRGB, 5, 2)
                    strG = Mid(strRGB, 3, 2)
                    strB = Mid(strRGB, 1, 2)
                    
                    'HTMLを作る
                    strHTML = strHTML & "<font color=#" & strR & strG & strB & ">"
                    flgFONT = "ON"  'HTML出力中にする
                    motoCOLOR = lngRGB   '今の色を入れて変化なしにする
                End If
            End If
           
            '.BOLDが太字から変化したら、Bタグを作る
            If motoBOLD <> bBOLD Then
                If flgB = "OFF" Then  'OFFの時、タグを開始
                    'HTMLを作る
                    strHTML = strHTML & "<B>"
                    flgB = "ON"  'HTML出力中にする
                    motoBOLD = bBOLD  'そのま太字にして変化なしにする
                End If
            End If
        
        'タグを閉じる
            '.BOLDが太字から変化したら、Bタグを作る
            If motoBOLD <> bBOLD Then
                strHTML = strHTML & "</B>"
                flgB = "OFF"
            End If
        
            '色が変化したら、FONTタグを作る
            If motoCOLOR <> lngRGB Then
                strHTML = strHTML & "</font>"
                flgFONT = "OFF"
            End If
        
        'もじをそのままタス
            strHTML = strHTML & strMOJI
            
            '現在の状態を保存する
            motoCOLOR = lngRGB  '色を保存
            motoBOLD = bBOLD    '太字を保存
        Next n
        
        'HTMLのタグがONのままなら 閉じる
        '太字をチェックして閉じる
        If flgB = "ON" Then  'ONのまま行が変わったら
            strHTML = strHTML & "</B>"
            flgB = "OFF"
        End If
        
        '/FONTのチェック
        If flgFONT = "ON" Then  'ONのまま行が変わったら
            strHTML = strHTML & "</font>"
            flgFONT = "OFF"
        End If

        '行の終わりは<BR>
        strHTML = strHTML & "<BR>" & vbCrLf
    Next y
    
    '結果表示
    Debug.Print "HTML=" & strHTML

End Sub



また、初回の失敗ライブは
https://www.youtube.com/watch?v=qj2TkJvbmdU

http://q.hatena.ne.jp/1545016721
の質問への回答テスト

マクロ記録からプロパティを探る

'With ActiveCell.Characters(Start:=11, Length:=5).Font

です、お時間のある人は見て笑ってください・・・※今回も失敗ライブだけどね(笑)

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。
・[Excel/Access VBA]の解説
・[ASP(Active Server Pages)]の解説。
・[元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
・[プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
三流君を踏み台にする
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。

三流解説動画の再生リスト
https://www.youtube.com/user/ken3video/playlists

本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)