愚者の経験

「また今度」はほとんどこない

Accessで漢字からふりがなを取得する

「VBA ふりがな取得」でぐぐってみたら大体
「Excelを参照設定してWorkSheetFunctionのGetPhoneticを使う」
以外に方法がないような感じです。

ですがAccessで、出来れば参照設定無しで使いたいのでいろいろ調べた結果
「IFELanguageオブジェクト」というものにたどり着きました。

これを操作して漢字からふりがなを取得するモジュールを公開します。
ソースは以下になります。

Option Compare Database
Option Explicit

Private Type GUID
     Data1 As Long
     Data2 As Integer
     Data3 As Integer
     Data4(0 To 7) As Byte
End Type

Private Type TinyMORRSLT
     dwSize As Long
     pwchOutput As Long
     cchOutput As Integer
End Type

'メモリ関連API
Private Declare Sub MoveMemory Lib "kernel32" _
                Alias "RtlMoveMemory" ( _
                ByRef Destination As Any, _
                ByRef Source As Any, _
                ByVal Length As Long)

'Com関連API
Private Declare Function CoCreateInstance Lib "ole32" ( _
                ByRef rclsid As GUID, _
                ByVal pUnkOuter As Long, _
                ByVal dwClsContext As Long, _
                ByRef riid As GUID, _
                ByRef ppv As Long) As Long
Private Declare Function DispCallFunc Lib "oleaut32" ( _
                ByVal pvInstance As Long, _
                ByVal oVft As Long, _
                ByVal cc As Long, _
                ByVal vtReturn As Integer, _
                ByVal cActuals As Long, _
                ByRef prgvt As Integer, _
                ByRef prgpvarg As Long, _
                ByRef pvargResult As Variant) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" ( _
                ByVal pv As Long)
Private Declare Function CLSIDFromString Lib "ole32" ( _
                ByVal OleStringCLSID As Long, _
                ByRef cGUID As Any) As Long

Private Const CLSID_MSIMEJAPAN As String = "{EB144E8A-AF48-478B-8885-641A0BD2F56A}"
Private Const IID_IFELANGUAGE As String = "{019F7152-E6DB-11d0-83C3-00C04FDDB82E}"

Private Const FELANG_REQ_CONV = &H10000
Private Const FELANG_REQ_RECONV = &H20000
Private Const FELANG_REQ_REV = &H30000

'変換モード定数
Private Const FELANG_CMODE_MONORUBY = &H2
Private Const FELANG_CMODE_NOPRUNING = &H4
Private Const FELANG_CMODE_KATAKANAOUT = &H8
Private Const FELANG_CMODE_HIRAGANAOUT = &H0
Private Const FELANG_CMODE_HALFWIDTHOUT = &H10
Private Const FELANG_CMODE_FULLWIDTHOUT = &H20
Private Const FELANG_CMODE_BOPOMOFO = &H40
Private Const FELANG_CMODE_HANGUL = &H80
Private Const FELANG_CMODE_PINYIN = &H100
Private Const FELANG_CMODE_PRECONV = &H200
Private Const FELANG_CMODE_RADICAL = &H400
Private Const FELANG_CMODE_UNKNOWNREADING = &H800
Private Const FELANG_CMODE_MERGECAND = &H1000
Private Const FELANG_CMODE_ROMAN = &H2000
Private Const FELANG_CMODE_BESTFIRST = &H4000
Private Const FELANG_CMODE_USENOREVWORDS = &H8000
Private Const FELANG_CMODE_NONE = &H1000000
Private Const FELANG_CMODE_PLAURALCLAUSE = &H2000000
Private Const FELANG_CMODE_SINGLECONVERT = &H4000000
Private Const FELANG_CMODE_AUTOMATIC = &H8000000
Private Const FELANG_CMODE_PHRASEPREDICT = &H10000000
Private Const FELANG_CMODE_CONVERSATION = &H20000000
Private Const FELANG_CMODE_NAME = FELANG_CMODE_PHRASEPREDICT
Private Const FELANG_CMODE_NOINVISIBLECHAR = &H40000000

'ふりがな取得関数
Public Function Phonetic(ByVal Value As String) As String
    Dim ret As Variant
    Dim MSIME_GUID As GUID
    Dim IFELanguage_GUID As GUID
    Dim lpIFE As Long

    'MSIME.JAPANのCLSIDをGUID型にセット
    CLSIDFromString StrPtr(CLSID_MSIMEJAPAN), MSIME_GUID
    'IFELanguageのIIDをGUID型にセット
    CLSIDFromString StrPtr(IID_IFELANGUAGE), IFELanguage_GUID

    'CLSIDとIIDからIFELanguageオブジェクト作成
    If (CoCreateInstance(MSIME_GUID, 0, 1, IFELanguage_GUID, lpIFE) <> 0) Then
        Err.Raise 500, "Phonetic", "オブジェクトの作成に失敗しました。"
    End If

    'IUnknownインターフェイスのAddRefメソッド
    DispCallFunc lpIFE, 4, 4, vbLong, 0, 0, 0, ret
    'IFELanguageのOpenメソッド
    DispCallFunc lpIFE, 12, 4, vbLong, 0, 0, 0, ret

    Dim pArgs(0 To 5) As Long
    Dim vt(0 To 5) As Integer
    Dim Args(0 To 5) As Long
    Dim ResultPtr As Long
    Dim TinyM As TinyMORRSLT
    Dim buff() As Byte
    Dim i As Integer

    'GetMorphResultの引数準備(dwRequest,dwCMode,cwchInput,pwchInput,pfCInfo,ppResult)
    'dwRequest変換方法(逆変換)
    Args(0) = FELANG_REQ_REV
    'dwCMode変換モード
    Args(1) = FELANG_CMODE_SINGLECONVERT Xor FELANG_CMODE_HALFWIDTHOUT
    'cwchInput文字列長
    Args(2) = Len(Value)
    'pwchInput文字列のメモリポインタ
    Args(3) = StrPtr(Value)
    'pfCInfo???
    Args(4) = 0
    'ppResult結果のメモリポインタ
    Args(5) = VarPtr(ResultPtr)

    For i = 0 To 5
        vt(i) = vbLong
        pArgs(i) = VarPtr(Args(i)) - 8
    Next

    'IFELanguageのGetMorphResultメソッド
    DispCallFunc lpIFE, 20, 4, vbLong, 6, vt(0), pArgs(0), ret

    'アドレスから結果を取得
    MoveMemory TinyM, ByVal ResultPtr, Len(TinyM)
    If (TinyM.cchOutput > 0) Then
        '文字列バッファのリサイズ
        ReDim buff(0 To TinyM.cchOutput * 2 - 1)

        'よみ取得
        MoveMemory buff(0), ByVal TinyM.pwchOutput, TinyM.cchOutput * 2

        'バイト配列文字列をString変換
        Phonetic = buff
    End If

    'メモリ解放
    CoTaskMemFree ResultPtr
    'IUnknownインターフェイスのReleaseメソッド
    DispCallFunc lpIFE, 8, 4, vbLong, 0, 0, 0, ret
    'IFELanguageのCloseメソッド
    DispCallFunc lpIFE, 16, 4, vbLong, 0, 0, 0, ret

End Function

使うときは「Phonetic(“ふりがな取得”)」のように使います。

なお、コメントは私の予想が多分に含まれていますのであまりアテになりません。
IFELanguageオブジェクトを連続で使うときは、毎回Closeしないほうがいいですね。

広告

Accessで漢字からふりがなを取得する」への4件のフィードバック

  1. 中村 6月 1, 2013 1:56 pm

    初めまして、便利に使わせて頂いています。
    私は素人なので別けも分からず使わせて頂いていまずが、
    今回、バグらしき挙動を発見しましたので、直るものであれば直して頂きたく、
    厚かましくも書き込みをさせていただきました。

    私のPCだけの挙動かもしれませんので、その場合はご容赦下さい。
    環境は、win7 アクセス2010
    挙動は、基本はひらがなに変換するのですが、「めぐ」の文字を変換すると
    アクセスが落ちてしまいます。
    「め」や「ぐ」の単体では落ちません。
    なにとぞ、検証頂けますようお願い申しあげます。

    • rsskkr 6月 1, 2013 11:12 pm

      中村様
      はじめましてrsskkrです。拙いブログですが、見ていただいた上に
      コメントしていただけて大変嬉しく思います。

      コメント頂いた件ですが、こちらでも同様に発生しました。
      実行環境:XP Pro SP3 + Access 2010 SP無
      調べていましたが、さっぱりわからずでした。

      「”めぐ”」で落ちてしまう原因は不明ですが
      「先頭に適当に文字を足し、最後に抜く」という力技でおそらく解決
      出来ますのでお伝えしておきます。

      以下ソースです。結果に変動がでないとも限りません…
      これからも本ブログをよろしくお願い致します。
      Public Function Phonetic(ByVal Value As String) As String
      Dim ret As Variant
      Dim sVal As String
      Dim MSIME_GUID As GUID
      Dim IFELanguage_GUID As GUID
      Dim lpIFE As Long

      Dim pArgs(0 To 5) As Long
      Dim vt(0 To 5) As Integer
      Dim Args(0 To 5) As Long
      Dim ResultPtr As Long
      Dim TinyM As TinyMORRSLT
      Dim buff() As Byte
      Dim I As Integer

      ‘”めぐ”で落ちる対策
      sVal = “@” & Value

      ‘MSIME.JAPANのCLSIDをGUID型にセット
      CLSIDFromString StrPtr(CLSID_MSIMEJAPAN), MSIME_GUID
      ‘IFELanguageのIIDをGUID型にセット
      CLSIDFromString StrPtr(IID_IFELANGUAGE), IFELanguage_GUID

      ‘CLSIDとIIDからIFELanguageオブジェクト作成
      If (CoCreateInstance(MSIME_GUID, 0, 1, IFELanguage_GUID, lpIFE) 0) Then
      Err.Raise 500, “Phonetic”, “オブジェクトの作成に失敗しました。”
      End If

      ‘IUnknownインターフェイスのAddRefメソッド
      DispCallFunc lpIFE, 4, 4, vbLong, 0, 0, 0, ret
      ‘IFELanguageのOpenメソッド
      DispCallFunc lpIFE, 12, 4, vbLong, 0, 0, 0, ret

      ‘GetMorphResultの引数準備(dwRequest,dwCMode,cwchInput,pwchInput,pfCInfo,ppResult)
      ‘dwRequest変換方法(逆変換)
      Args(0) = FELANG_REQ_REV
      ‘dwCMode変換モード
      Args(1) = FELANG_CMODE_SINGLECONVERT Xor FELANG_CMODE_HALFWIDTHOUT
      ‘cwchInput文字列長
      Args(2) = Len(sVal)
      ‘pwchInput文字列のメモリポインタ
      Args(3) = StrPtr(sVal)
      ‘pfCInfo???
      Args(4) = 0
      ‘ppResult結果のメモリポインタ
      Args(5) = VarPtr(ResultPtr)

      For I = 0 To 5
      vt(I) = vbLong
      pArgs(I) = VarPtr(Args(I)) – 8
      Next

      ‘IFELanguageのGetMorphResultメソッド
      DispCallFunc lpIFE, 20, 4, vbLong, 6, vt(0), pArgs(0), ret

      ‘アドレスから結果を取得
      MoveMemory ByVal VarPtr(TinyM), ByVal ResultPtr, 4 * 3
      If (TinyM.cchOutput > 0) Then
      ‘文字列バッファのリサイズ
      ReDim buff(0 To TinyM.cchOutput * 2 – 1)

      ‘よみ取得
      MoveMemory buff(0), ByVal TinyM.pwchOutput, TinyM.cchOutput * 2

      ‘バイト配列文字列をString変換
      Phonetic = buff
      ‘先頭の「@」除去
      Phonetic = Mid$(Phonetic, 2)
      End If

      ‘メモリ解放
      CoTaskMemFree ResultPtr
      ‘IUnknownインターフェイスのReleaseメソッド
      DispCallFunc lpIFE, 8, 4, vbLong, 0, 0, 0, ret
      ‘IFELanguageのCloseメソッド
      DispCallFunc lpIFE, 16, 4, vbLong, 0, 0, 0, ret

      End Function

      最後に…宜しければなぜこの関数を使うのか教えていただけますか?
      正直自分でも「変換できるかな~」と興味本位で無理やり作ったので、
      実用性を考えて作ったわけではありません。
      Accessは基本的にテキストボックスで「ふりがな」機能を備えていますし、
      ExcelはGetPhoneticがそもそも使えますし、
      コードも美しくない(DispCallFuncとかMoveMemoryとか)ので
      見向きもされないと思っていました(笑)

      • 中村 6月 3, 2013 2:39 pm

        ご連絡ありがとうございます。

        大変助かりました。
        若干の変更はいたしましたが、正常に動いております。
        変更した箇所は、「@」のところで、「たんか」と訳されてしまい、
        mid関数の引数に狂いが生じたので、その部分だけを訂正いたしました。
        そこ以外は全く理解出来ていません(笑)

        さて、使用方法ですが
        私は、貿易会社(卸売・ドロップシッピング)でシステムを組んでいます。
        その際、過去のデータなどふりがながないデータをクエリなどを使用して
        ふりがなをつけたり、
        クリップボードから、フォーム上のテキストボックスに貼り付ける際にも
        使用しています。

        なので、関数でふりがなにする必要がありました。本当にありがとうございました。

      • rsskkr 6月 3, 2013 6:11 pm

        中村様
        わざわざご報告いただき感謝致します。

        「@」で影響はないかと思ったのですが甘かったです。「たんか」ですか…
        ご使用用途も丁寧にお答えいただき大変勉強になりました。

        また本ブログがお役に立てて嬉しく思います。
        これからもよろしくお願いします、ありがとうございました。

        rsskkr

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト / 変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト / 変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト / 変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト / 変更 )

%s と連携中

%d人のブロガーが「いいね」をつけました。