特集記事

VBAからUnicode版のWindows API を使う

VBAにおけるUnicodeの取り扱い

2008/01/31 14:00

ポスト

Unicode文字列版 APIを呼ぶときのポイント

　APIを呼ぶ手順はANSI文字列版のときとほぼ同じですが、以下の点が違います。

　標準モジュールにDeclare ステートメントでAPI 関数を定義するとき、引数が文字列の部分は、ANSI文字列版では文字列型（String）をByValで定義しましたが、Unicode文字列版では長整数型（Long）をByValで定義してください。

　GetUserName関数で比較すると以下のようになります。

ANSI文字列版の場合

Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long

UNICODE文字列版の場合

Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameW" _
    (ByVal lpBuffer As Long, nSize As Long) As Long

　また、関数を呼び出すときに引数として文字列型（String）を渡す場合は、StrPtr関数で長整数型（Long）へキャストしてください。GetUserName関数を呼ぶ場合、以下のようになります。

例

'sは文字列型（String）
GetUserName StrPtr(s), size

Unicode文字列版 APIに文字列を渡す

　MsgBox関数はUnicodeに対応していませんでしたが、Windows APIのMessageBoxW関数を使って、Unicodeに対応したMsgBoxEx関数を作ってみます。

Unicodeに対応したMsgBoxEx()関数

'標準モジュールに以下のDeclare ステートメントを追加
Declare Function MessageBox Lib "user32" Alias "MessageBoxW" _
    (ByVal hwnd As Long, ByVal lpText As Long, _
     ByVal lpCaption As Long, ByVal wType As Long) As Long
Declare Function GetFocus Lib "user32" () As Long

'MsgBoxEx()関数
Sub MsgBoxEx(Text As String)
    Dim Caption As String
    Caption = "Microsoft Excel" 'キャプション
    'StrPtr()関数で長整数型（Long）にキャスト
    MessageBox GetFocus(), StrPtr(Text), StrPtr(Caption), 0
End Sub

'MsgBoxEx()関数の使用例
Sub Test()
    Dim Text As String
    Text = "千代田区" & ChrW(&H9EB4) & "町"
    MsgBoxEx Text
End Sub

実行例

Unicode文字列版 APIで文字列を受け取る

　APIのGetUserNameW()関数を使って補助漢字を含むユーザー名を取得してみます。

　事前に森鴎外（「鴎」は補助漢字 U+9DD7）というユーザーを作成し、ログオンした状態でマクロを実行してください。

補助漢字を含むユーザー名を取得する

'標準モジュールに以下のDeclare ステートメントを追加
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameW" _
    (ByVal lpBuffer As Long, nSize As Long) As Long

'使用例
Sub Test()
    Dim Buffer As String
    Dim Size As Long

    Buffer = String(256, vbNullChar) 'バッファにNull文字をセット
    Size = 256
    'StrPtr()関数で長整数型（Long）にキャスト
    GetUserName StrPtr(Buffer), Size
    'ANSI文字列版と同様、余分なNullCharを削除する
    Buffer = Left(Buffer, InStr(1, Buffer, vbNullChar) - 1)
    'ワークシートのA1セルへ書き込み
    ThisWorkbook.ActiveSheet.Range("A1").Value = Buffer
End Sub