VBA：ChrW関数でU+10000以降の文字を取得

先日Windows 7（のSegoe UI Symbol）にケータイ絵文字が追加されたという話を書きました。その補足的なことです。

BMP領域（U+FFFFまで）・拡張領域（U+10000以降）を問わず、一つのUnicodeの文字コードから文字自体を得るのはかんたんです。ワードパッドやMS Wordで文字コードを入力、その後ろでAlt+Xを入力すれば変換されます。下図はU+1F4F6（ケータイのアンテナマーク）をワードパッド上で変換したところです。

フォントはSegoe UI Symbolにしています。もう一度Alt+Xを入力すると文字コードに戻ります。

さてVBAでこのような変換をする場合、 ChrW関数だとBMP領域しか対応できません。
というか、拡張領域の文字はBMP領域の文字2つを連結して表す仕組みになっています（サロゲートペア） 。

＜参考＞Unicode文字のマッピング・代用符号位置 - Wikipedia

上のリンク先には、U+10000以降の文字コードは2つの文字（上位サロゲート・下位サロゲート）を使って下記の数式で求められるとあります。

&H10000 + (上位サロゲート - &HD800) × &H400 + (下位サロゲート - &HDC00)

この数式から逆に2つの文字を求めてChrW関数で変換、連結すれば目的の文字が得られるでしょう。以下のようにユーザー定義関数を作りました。

Public Function ChrW_SP(ByVal CharCode As Long) As String
Dim HS As Long '上位サロゲート
Dim LS As Long '下位サロゲート

    If CharCode < &H10000 Then Exit Function
    CharCode = CharCode - &H10000 '元のコードから&H10000を引く
    HS = (CharCode \ &H400) + &HD800 '上位：&H400で割った商に&HD800を足す
    LS = (CharCode Mod &H400) + &HDC00 '下位：&H400で割ったあまりに&HDC00を足す
    ChrW_SP = ChrW(HS) & ChrW(LS) '連結

End Function

下図はExcelのシート上でこの関数を使ってみたところです。HEX2DEC関数で10進に変換してから渡しています。「字形」の列はフォントをSegoe UI Symbolにしています。

こういう表が作りたかったので調べてみました。