【VBA】文字を隠したいならセルの色に埋め込んじゃえばいいじゃない…

！！ノンプロ研企画アドベントカレンダー！！

こちらは私が所属しているコミュニティ「ノンプログラマーのためのスキルアップ研究会」通称「ノンプロ研」の年末特別企画、ノンプロ研 Advent Calendar 2019 の17日目の記事として投稿しています。
adventar.org

なんて書いてあるの？

突然ですが、この色のついたセル、ここになんて書いてあるかわかるでしょうか…
勘のいいひとならわかりますよね？え？わかる？ほんとにわかるの？マジで！？

いや、まぁ、一般的にはわかりませんよね。

でも、これをある方法で変換すると文字列がでてきます。

「The quick brown fox jumps over the lazy dog.」

今回はこの方法について説明していきます。

たねあかし

たねあかしをすると簡単です。

文字コード（アスキーコード）を２倍してRGBのそれぞれにあてていたんですね。２倍にしているのは、そのままだと色が暗くなってしまうからです。主要な文字のアスキーコードは 127 までで、２倍しても 254 となり色の範囲の 0 ～ 255 に収まるので大丈夫です。もし暗い色味の方がお好みの方は２倍にしなくてもいいです。

実装

やり方がわかったので実装してみましょう！
今回は標準モジュールに書いていきます。

【シートと標準モジュールの準備】

シートのオブジェクト名を変更し標準モジュールを追加しましょう。

オブジェクト	オブジェクト名
Sheet1	wsMain
標準モジュール	mdlMain

ついでに、Sheet1のA1セルに「埋め込む文字列：」、A2セルに「抽出した文字列：」と書いておきます。
また、セルの幅と高さは42ピクセルにしていますが、このサイズはお好みで。

【定数の宣言、シートの準備】

定数も宣言しておきましょう。

定数名	意味
RNG_TEXT	埋め込む文字列を記入するセル
RNG_DECODE_TEXT	抽出した文字列を表示するセル
RW.CLR_START	色を付けるセルの開始列
CL.CLR_START	色を付けるセルの開始行

Const RNG_TEXT As String = "D1"
Const RNG_DECODE_TEXT As String = "D2"

Enum RW
    CLR_START = 6
End Enum

Enum CL
    CLR_START = 5
End Enum

【埋め込み処理】

文字列を１文字ずつアスキーコードに変換して色として設定していきます。
RGBそれぞれに１文字を割り当てているので、３文字で１カラーになります。

Public Sub Click_埋め込む()
    Dim strText As String
    Dim strChar As String
    Dim clrR As Long, clrG As Long, clrB As Long
    Dim clrNum As Long
    Dim i As Long
    Dim r As Long
    Dim c As Long
    Dim flag As Boolean
    
    With wsMain
    
        '初期化
        .Cells.Interior.ColorIndex = xlNone
        .Range(RNG_DECODE_TEXT).ClearContents
        
        '埋め込む文字列を取得
        strText = .Range(RNG_TEXT).Value
        
        r = RW.CLR_START
        c = CL.CLR_START - 1
        
        '文字列の長さまで繰り返す
        For i = 1 To Len(strText)
        
            '[ 1 ] 文字を一文字取り出して、アスキーコードに変換して２倍する
            strChar = Mid(strText, i, 1)
            clrNum = Asc(strChar) * 2
            
            flag = False
            Select Case i Mod 3
                Case 1          '[ 2 ] G,B を初期化し、R（赤）を設定、色を付けるセルの行、列を更新
                    clrG = 255
                    clrB = 255
                    
                    clrR = clrNum
                    
                    c = c + 1
                    If c > 10 Then
                        r = r + 1
                        c = CL.CLR_START
                    End If
                
                Case 2          '[ 3 ] G（緑）を設定
                    clrG = clrNum
                
                Case Else      '[ 4 ] B（青）を設定し、セルに色を付ける
                    clrB = clrNum
                    .Cells(r, c).Interior.Color = RGB(clrR, clrG, clrB)
                    flag = True
                    
            End Select
            
        Next
        
        '[ 5 ] 文字数の関係でBまで設定できなかった場合、セルに着色されていないのでここで着色する
        If Not flag Then
            .Cells(r, c).Interior.Color = RGB(clrR, clrG, clrB)
        End If
        
    End With

End Sub

コードの解説

コードのポイントについて解説します。

[ 1 ] 文字を一文字取り出して、アスキーコードに変換して２倍する

For文でぐるぐる回しながら１文字ずつ取得していきます。文字を取得したら Asc() でアスキーコードに変換します。今回は色を明るくしたいので２倍しています。

[ 2 ] G,B を初期化し、R（赤）を設定、色を付けるセルの行、列を更新

対象とする文字の位置を３で割った余りが１の場合、つまり、１文字目、４文字目、７文字目…の処理です。[ 1 ] で得られたアスキーコードを R （赤）の色の値として変数に格納します。

RGBそれぞれが１文字に対応しているため、文字数によってはキリが悪くなることがあります（文字数が３で割り切れない場合）。その場合、GとBを初期化しておかないと前の色の値が残ったままになってしまうため、意図しない文字が埋め込まれてしまうことになります。今回は、初期値として 255 を設定し、値が 255 だった場合は文字を出力しないという設計にしています。

また、色を塗りたいセルの場所を更新しています。今回は横に10セル塗ったら行を変えるようにしていますが、この辺りはお好みで。

[ 3 ] G（緑）を設定

対象とする文字の位置を３で割った余りが２の場合、つまり、２文字目、５文字目、８文字目…の処理です。[ 1 ] で得られたアスキーコードを G （緑）の色の値として変数に格納します。

[ 4 ] B（青）を設定し、セルに色を付ける

対象とする文字の位置が３で割り切れる場合、つまり、３文字目、６文字目、９文字目…の処理です。[ 1 ] で得られたアスキーコードを B （青）の色の値として変数に格納します。

ここに到達した場合は R と G には色の値が格納されているので、セルに色を付けます。
flag は文字数の関係でここまで到達しなかった場合（R か G までで For を抜けた場合）に処理の最後で別途色を付ける必要があるため、その目安とするフラグです。

[ 5 ] 文字数の関係でBまで設定できなかった場合、セルに着色されていないのでここで着色する

flag が False の場合は、B まで到達せずに For を抜けた（着色されていない）ということを意味するので、ここで着色します。

【抽出処理】

さて、セルの色に文字を埋め込めたので、今度は抽出（復元）です。
セルの色情報から埋め込んだ文字列を抽出します。
セルの色を R, G, B に分解してそれぞれを１文字として変換すればOKです。

Public Sub Click_抽出する()
    Dim r As Long
    Dim c As Long
    Dim strText As String
    Dim clrNum As Long
    Dim hexR As String, hexG As String, hexB As String
    Dim lngR As Long, lngG As Long, lngB As Long
    Dim chrR As String, chrG As String, chrB As String
    
    With wsMain
        
        strText = ""
        r = RW.CLR_START
        c = CL.CLR_START
        '未着色セルが出現するまで繰り返す
        Do
            Do
                '[ 1 ] セルの色を取得し、16進数でRGBに変換する
                clrNum = .Cells(r, c).Interior.Color
                hexR = "&H" & Right(Hex(clrNum), 2)
                hexG = "&H" & Mid(Hex(clrNum), 3, 2)
                hexB = "&H" & Left(Hex(clrNum), 2)
                
                '[ 2 ] 16進数を10進数に変換する
                lngR = CLng(hexR)
                lngG = CLng(hexG)
                lngB = CLng(hexB)
                
                '[ 3 ] 色の値が255でなかったら２で割って文字に変換する
                If lngR <> 255 Then
                    lngR = lngR / 2
                    strText = strText & Chr(lngR)
                End If
                
                If lngG <> 255 Then
                    lngG = lngG / 2
                    strText = strText & Chr(lngG)
                End If
                
                If lngB <> 255 Then
                    lngB = lngB / 2
                    strText = strText & Chr(lngB)
                End If
                
                c = c + 1
            Loop Until .Cells(r, c).Interior.ColorIndex = xlNone
            r = r + 1
            c = CL.CLR_START
        Loop Until .Cells(r, c).Interior.ColorIndex = xlNone
        
        '[ 4 ] 取得した文字列を表示する
        .Range(RNG_DECODE_TEXT).Value = strText
        
    End With
    
End Sub

コードの解説

コードのポイントについて解説します。

[ 1 ] セルの色を取得し、16進数でRGBに変換する

Do - Loop でぐるぐる繰り返しながら１セルずつ処理していきます。

clrNum にセルの色を格納します。RGBに分解しやすいように、一度16進数に変換してから、右側２文字（R）、真ん中２文字（G）、左側２文字（B）に分け、「&H」を付加することで16進数に戻しています。
※ 取得された色の16進表記は「BGR」の順になっているので注意してください。（「RGB」の順ではないです。）

例えば、１つめのセルの色は10進数で「13291688」ですが、これを16進数に変換すると「CAD0A8」となります。
右側の２文字「A8」を取り出し文字列「&HA8」として、hexR に格納します。hexG、hexB も同様です。

[ 2 ] 16進数（文字列）を10進数に変換する

[ 1 ] で hexR、hexG、hexB に格納された文字列は「&H○○」の形式なので、16進数とみなすことができます。そこで、それぞれを CLng() を使って 10進数に変換します。
例えば、上で hexR に格納されているのは「&HA8」ですが、これを10進数に変換すると「168」になります。
同様に、hexG に格納されているのは「&HD0」なので「208」、hexB は「&HCA」なので「202」となります。

[ 3 ] 色の値が255でなかったら２で割って文字に変換する

さて、埋め込み処理の際に 255 にした場合は文字として出力しないことにするとしていたので、[ 2 ] で変換された数値が 255 でない場合のみ処理を行います。今回は、元の文字のアスキーコードを 2倍にして埋め込んでいるので、ここでは 2で割って元のアスキーコードに戻しています（lngR = lngR / 2）。
求めたアスキーコードを Chr() で文字に変換して、抽出された文字列（strText）に順次追加していきます。

[ 4 ] 取得した文字列を表示する

すべての色付きセルについて上記処理が終了したら、表示先セルに抽出された文字列を表示します。

【初期化処理】

「埋め込む文字列」、「抽出した文字列」、「着色されたセル」を初期化（クリア）する処理です。特に解説は不要でしょう。

Public Sub Click_クリア()
    With wsMain
        .Range(RNG_TEXT).ClearContents
        .Range(RNG_DECODE_TEXT).ClearContents
        .Cells.Interior.ColorIndex = xlNone
    End With
End Sub

ボタンに書く処理を割り当てて完成

あとは適当にボタンを作って、「Click_埋め込む()」、「Click_抽出する()」、「Click_クリア()」の処理を割り当てれば完成です。
いろいろな文字列でどんな色になるか試してみましょう！

これの用途

まぁ、これが何に使えるのかっていうのは…私もよくわかりません。。暗号？
でも、おもしろいからいいよね！