t-hom’s diary

主にVBAネタを扱っているブログです。

VBAでパスワード等の読みを作成するマクロ

パスワードを発行して通知する場合、i,l,1や0,Oなどの紛らわしい文字を確実に伝えるために、カタカナで読みを付けることがある。
そこで今回は、"a"を渡すと"エー"が帰ってくる関数を作りたいと思う。

こういう方法が一般的だが、

Function GetPhonetic(Charactor As String) As String
    Dim Ret As String
    Select Case Charactor
    Case "a": Ret = "エー"
    Case "b": Ret = "ビー"
    Case "c": Ret = "シー"
    
            '・・・続く
    
    End Select
    GetPhonetic = Ret
End Function

これではあまりにも芸が無いし、ひと文字ずつのケース判定も面倒くさい。
そこで、文字コードを利用してもう少し簡潔に書ける方法を考えた。
以下がそのコードである。

Function GetPhonetic(Charactor As String) As String
    Dim AsciiCode As Long: AsciiCode = Asc(LCase(Charactor))
    '変数AsciiCodeはByte型で充分であるが、
    'オーバーフローエラーの処理が面倒なので、
    'Long型にしてCase Elseで拾う。
    
    Dim Phonetic As String
    Select Case AsciiCode
        Case 0 To 31
            Phonetic = "" '制御文字のため読みは無し
            
        Case 32 To 47
            Phonetic = Split( _
                "スペース ビックリ ダブルクォート シャープ " & _
                "ドル パーセント アンド シングルクォート " & _
                "ヒダリマルカッコ ミギマルカッコ アスタリスク " & _
                "プラス カンマ ハイフン ドット スラッシュ", " ") _
                    (AsciiCode - 32)
                    
        Case 48 To 57
            Phonetic = Split( _
                "ゼロ イチ ニ サン ヨン ゴ " & _
                "ロク ナナ ハチ ク ジュウ", " ") _
                    (AsciiCode - 48)
                    
        Case 58 To 64
            Phonetic = Split( _
                "コロン セミコロン ショウナリ イコール " & _
                "ダイナリ ハテナ アット", " ") _
                    (AsciiCode - 58)
                    
        Case 65 To 90
            'アルファベット大文字のケース。
            'ただし、Select文の前に小文字に変換しているため、
            'このケースは存在しない。
            
        Case 91 To 96
            Phonetic = Split( _
                "ヒダリカクカッコ エン ミギカクカッコ ハット " & _
                "アンダースコア バッククォート", " ") _
                    (AsciiCode - 91)
                    
        Case 97 To 122
            Phonetic = Split( _
                "エー ビー シー ディー イー エフ ジー " & _
                "エイチ アイ ジェイ ケー エル エム エヌ " & _
                "オー ピー キュー アール エス ティー ユー " & _
                "ブイ ダブリュー エックス ワイ ゼット", " ") _
                    (AsciiCode - 97)
                    
        Case 123 To 126
            Phonetic = Split( _
                "ヒダリナミカッコ パイプ ミギナミカッコ チルダ", " ") _
                    (AsciiCode - 123)
        Case 127
            Phonetic = "" '制御文字のため読みは無し
        
        Case Else
            Err.Raise 1000, "getPhonetic", _
                "getPhonetic:ASCIIコードの範囲0~127を超えています。"
            
    End Select
    
    GetPhonetic = Phonetic
    
End Function

そして、うまくいっているかテストのための全文字出力コード

Sub test()
    Dim i As Byte
    For i = 32 To 126
        Debug.Print Chr(i), GetPhonetic(Chr(i))
    Next
End Sub

次に、文字列の読みを表示するテスト

Sub StringTest()
    Dim buf: buf = "Password#123"
    Dim result
    For i = 1 To Len(buf)
        result = result & StrConv(GetPhonetic(Mid(buf, i, 1)), vbNarrow) & "・"
        '半角カナに変換して黒丸で区切っている。
    Next i
    result = Left(result, Len(result) - 1)  'ひとつ黒丸を付けすぎるので消す。
    Debug.Print buf
    Debug.Print result
End Sub

我ながら、なかなか綺麗に仕上がった気がする。(読みやすいかどうかは別)
リテラルを直接書くのは良くないといわれるが、この場合はCase文をASCIIコードの0~127まで通しているので変数にするより素直にリテラルのままの方が美しいと判断した。

Split関数でとれた配列に直接添え字を指定して値を取るのは、私がよく使うイディオムである。
たとえば以下のように書くと、イミディエイトウインドウに"エー"と表示される。

Debug.Print Split("エー ビー シー", " ")(0)

たとえば、以下はその応用である。

        Case 97 To 122
            Phonetic = Split( _
                "エー ビー シー ディー イー エフ ジー " & _
                "エイチ アイ ジェイ ケー エル エム エヌ " & _
                "オー ピー キュー アール エス ティー ユー " & _
                "ブイ ダブリュー エックス ワイ ゼット", " ") _
                    (AsciiCode - 97)

最後の(AsciiCode -97)というのは、a~zの文字コードから、aの文字コード(97)を引けば、a b cの順に0 1 2がとれるので、それを添え字に使っている。

こうしたテクニックはコードの冗長性を減らすことに貢献するが、可読性を落とすことにもつながるため、手間がかからないケースでは素直なコードを心がけたい。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。