愚者の経験

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

月別アーカイブ: 7月 2012

Office XP DeveloperでVBEのアドインを作ってみる その1

Office XP DeveloperでVBEのアドインを作ることができます。
前々から気になっていたのです。VBAにも以下のようなツールがあります。
VBAの自動インデントツール:http://www.oaltd.co.uk/Indenter/Default.htm

VBE(Visual Basic Editor)の画面に「アドイン」があることは知っていましたが
アドインそのものが少なく、めったに見ることがないのが現状だと思います。

話が変わりますがHTMLのツールで「zen-Coding」というものがあります。
zenCoding:http://techblog.yahoo.co.jp/tips/_zencoding/

私もNotepad++で使っています。非常に便利です。

そこでVBAでも「zen-Coding」みたいなこと出来ないかなと思っていたところ
VBEにアドインがあることを知り、自分用のコーディング高速化のcomアドインを作ろうと思いました。

大体記述するパターンは決まっています。
・If (~~) Then ~~ End If
・If (~~) Then ~~ Else ~~ End If
・Dim i As Long ~~ For i = m To n ~~ Next

など挙げると結構ありそうです。
このあたりをショートカットキーで一発で変換出来るようになるものを目指してこれから作っていきます。

広告

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しないほうがいいですね。

行挿入考察(3)

前回の投稿の続き
簡単な行挿入ロジックの条件は「挿入するデータのみで実現する」です。

小数点を使えばいけるんじゃないかと思ったのでやってみます。
・「[並び順]-0.1を並び順にする」
つまり今回の例で言うと

並び順:(2-0.1) 値:行挿入!

をInsertするということです。
Insertした結果はこうなります。

並び順:1 値:あいうえお
並び順:1.9 値:行挿入!
並び順:2 値:かきくけこ
並び順:3 値:さしすせそ

結果はOKです。しかしもう一度「【並び順:2 値:かきくけこ】に行挿入する」とどうでしょう。

並び順:1 値:あいうえお
並び順:1.9 値:行挿入!
並び順:1.9 値:行挿入?
並び順:2 値:かきくけこ
並び順:3 値:さしすせそ

これは…ダメです。並び順が1.9同士が揃い、2行目と3行目で並び順がわかりません。

この通り「同じデータ(この場合「【並び順:2 値:かきくけこ】のデータ)から何度も行挿入が行われる」
可能性があるため、一定の値を足したり引いたりして並び順を求めることはできないのです。
これが行挿入機能の実装の難しさになっています。

基本的には挿入後に各行にアクセスしてそれぞれの並び順を振り直すしかない様に思えます。
誰かこれを解決した画期的な行挿入ロジックはないものでしょうか?アイデアを求むですm(__)m

行挿入考察(2)

前回の投稿の続き
簡単な行挿入ロジックの条件は「挿入するデータのみで実現する」です。

小数点を使えばいけるんじゃないかと思ったのでやってみます。
・「[並び順]-0.1を並び順にする」
つまり今回の例で言うと

並び順:(2-0.1) 値:行挿入!

をInsertするということです。
Insertした結果はこうなります。

並び順:1 値:あいうえお
並び順:1.9 値:行挿入!
並び順:2 値:かきくけこ
並び順:3 値:さしすせそ

結果はOKです。しかしもう一度「【並び順:2 値:かきくけこ】に行挿入する」とどうでしょう。

並び順:1 値:あいうえお
並び順:1.9 値:行挿入!
並び順:1.9 値:行挿入?
並び順:2 値:かきくけこ
並び順:3 値:さしすせそ

これは…ダメです。並び順が1.9同士が揃い、2行目と3行目で並び順がわかりません。

この通り「同じデータ(この場合「【並び順:2 値:かきくけこ】のデータ)から何度も行挿入が行われる」
可能性があるため、一定の値を足したり引いたりして並び順を求めることはできないのです。
これが行挿入機能の実装の難しさになっています。

行挿入考察(1)

データ入力の機能に「途中に行を挿入したい」という需要は当然あります。
一見ポピュラーな機能に思えますが、この「行挿入」には複雑な問題がついて回ります。

データが以下のようにあったとします。

並び順:1 値:あいうえお
並び順:2 値:かきくけこ
並び順:3 値:さしすせそ

列[並び順]によってデータをならべているものとし、

並び順:? 値:行挿入!

を2行目に行を挿入したい場合ぱっと思いつく方法はこれです。

並び順:2 値:かきくけこ
並び順:3 値:さしすせそ

並び順:3 値:かきくけこ
並び順:4 値:さしすせそ

に更新した後、

並び順:2 値:行挿入!

をInsertする。

並び順:1 値:あいうえお
並び順:? 値:行挿入!
並び順:3 値:かきくけこ
並び順:4 値:さしすせそ

なにが面倒くさいかというと「行挿入したいデータ1行だけに完結しない」ことです。
今回の場合挿入したい行のほかにすでにある2行を更新しなければいけません。
「簡単なロジックかつ周りの行に影響を及ぼさない」
そんな理想の行挿入ロジックを考察してみます。