年賀状ソフトなどで良く見かける「ふりがな自動入力」です。ユーザーフォーム上で氏名や住所等のカナ漢字変換での入力したカナ文字を「横取り」して「フリガナ」の項目に表示します。
ふりがなの取得には複数の方法があります。
ユーザーフォーム上でのふりがな取得だとしても複数の方法が考えられます。
・このページのようにIMEを強引に操作する方法
・シート上で「PHONETIC関数」を使って代行させる方法
などです。
このページで紹介している方法は、IMEの種類やバージョンによって正しく動作しないことも考えられますのでご注意下さい。
なお「PHONETIC関数を使って代行させる方法」については、「ユーザーフォーム上でヨミガナを自動表示(VBA応用)」をご覧下さい。
・このページのようにIMEを強引に操作する方法
・シート上で「PHONETIC関数」を使って代行させる方法
などです。
このページで紹介している方法は、IMEの種類やバージョンによって正しく動作しないことも考えられますのでご注意下さい。
なお「PHONETIC関数を使って代行させる方法」については、「ユーザーフォーム上でヨミガナを自動表示(VBA応用)」をご覧下さい。
64ビット版Excelの対応を行ないましたが．．．
このページのサンプルはAPIを使用しております。
Office365やOffice2019では、64ビット版になるという情報があったため、 当ページも対応していたのですが、このページのサンプルは64ビット版Excelでは正しく動作しません。
Office365やOffice2019では、64ビット版になるという情報があったため、 当ページも対応していたのですが、このページのサンプルは64ビット版Excelでは正しく動作しません。
表示されるフォームの「住所」にIMEで漢字を入力すると「フリガナ」が自動的に表示されます。(※Excel2000以降でのみ動作します。)
(この画像をクリックすると、ダウンロードができます。)
これもかなり込み入ったAPI利用ですが、「modPoneticTextBox」をインポートしてユーザーフォームの4カ所に呼び出す記述を加えるだけで利用可能です。
AddressOf演算子の利用例で、IMEから入力情報をフックします。作成は難しいですが、共通モジュール化しているので、モジュールをインポートすれば転用は簡単です。
これは、VBEのプロジェクトエクスプローラです。「modPoneticTextBox」が「ふりがな自動入力」部分です。ユーザーフォーム上のテキストボックスで処理するのであれば、このまま他にも利用できます。
ユーザーフォームのコードです。
'***************************************************************************************************
' フリガナの取得 ※ユーザーフォームのイベント記述 UserForm1(Class)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/08/20(1.00)新規作成
'***************************************************************************************************
Option Explicit
'***************************************************************************************************
' ■■■ フォームイベント(Private) ■■■
'***************************************************************************************************
'* 処理名 ：TextBox2_Enter
'* 機能 ：「住所」テキストボックスイべント(Enter)
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月20日
'* 作成者 ：井上 治
'* 更新日 ：2003年08月20日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TextBox2_Enter()
'-----------------------------------------------------------------------------------------------
' フリガナ監視TextBoxの設定
Call GP_PoneticSetEdit(TextBox2, TextBox1)
End Sub
'***************************************************************************************************
'* 処理名 ：TextBox2_Exit
'* 機能 ：「住所」テキストボックスイべント(Exit)
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月20日
'* 作成者 ：井上 治
'* 更新日 ：2003年08月20日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'-----------------------------------------------------------------------------------------------
' フリガナ監視TextBoxの解放
Call GP_PoneticResetEdit
End Sub
'***************************************************************************************************
'* 処理名 ：UserForm_Activate
'* 機能 ：ユーザーフォームの初期表示動作
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月20日
'* 作成者 ：井上 治
'* 更新日 ：2003年08月20日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub UserForm_Activate()
'-----------------------------------------------------------------------------------------------
TextBox1.Text = ""
TextBox2.Text = ""
End Sub
'***************************************************************************************************
'* 処理名 ：UserForm_Initialize
'* 機能 ：ユーザーフォームの初期化
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月20日
'* 作成者 ：井上 治
'* 更新日 ：2003年08月20日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub UserForm_Initialize()
'-----------------------------------------------------------------------------------------------
' フリガナ監視の開始
Call GP_PoneticInitialize(Me)
End Sub
'***************************************************************************************************
'* 処理名 ：UserForm_QueryClose
'* 機能 ：ユーザーフォームの終了処理
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月20日
'* 作成者 ：井上 治
'* 更新日 ：2003年08月20日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'-----------------------------------------------------------------------------------------------
' フリガナ監視の終了
Call GP_PoneticTerminate
ThisWorkbook.Saved = True
End Sub
'------------------------------------------<< End of Source >>--------------------------------------
- ①
- 「住所」のテキストボックスのEnterイベントで、IME監視するテキストボックスとフリガナをセットするテキストボックスを指定します。(GP_PoneticSetEdit)
- ②
- 「住所」のテキストボックスのExitイベントで、IME監視設定を解除します。(GP_PoneticResetEdit)
- ③
- ユーザーフォームの初期化処理で、IME監視を立ち上げます。内部でウィンドウのハンドルを取得するため、ユーザーフォーム自身を引数としています。(GP_PoneticInitialize)
- ④
- ユーザーフォームの終了処理で、IME監視を終了します。(GP_PoneticTerminate)
こちらが呼び出されている「modPoneticTextBox」です。
'***************************************************************************************************
' フリガナの取得 modPoneticTextBox(Module)
'
' ※TextBoxのIME操作情報から半角フリガナを別のTextBoxに表示する
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'03/08/20(1.00)新規作成
'19/11/04(1.10)64ビット版Office対応、記述標準化準拠
'20/01/07(1.20)ダミー引数廃止(Option Private Module)
'***************************************************************************************************
Option Explicit
Option Private Module
'===================================================================================================
Private Const WM_IME_COMPOSITION = &H10F
Private Const WM_CHAR = &H102
Private Const WM_KEYUP = &H101
Private Const GCS_RESULTREADSTR = &H200
Private Const GCS_RESULTSTR = &H800
Private Const GWL_WNDPROC = (-4)
Private Const g_cnsConvMode As Long = vbKatakana + vbNarrow ' 半角ｶﾅ
'Private Const g_cnsConvMode As Long = vbKatakana + vbWide ' 全角カナ
'-------------------------------------------------
#If VBA7 Then
' ■IME,Ponetic操作関連関数
' 変換中の文字列の情報を取得
Private Declare PtrSafe Function ImmGetCompositionString Lib "IMM32.dll" _
Alias "ImmGetCompositionStringA" _
(ByVal hIMC As Long, _
ByVal dw As Long, _
ByRef lpv As Any, _
ByVal dw2 As Long) As Long
' IMEのOpenステータスを取得
Private Declare PtrSafe Function ImmGetOpenStatus Lib "IMM32.dll" _
(ByVal hIMC As Long) As Long
' IMEのハンドルを取得
Private Declare PtrSafe Function ImmGetContext Lib "IMM32.dll" _
(ByVal hWnd As LongPtr) As Long
' 取得したIMEのハンドルを解放
Private Declare PtrSafe Function ImmReleaseContext Lib "IMM32.dll" _
(ByVal hWnd As LongPtr, _
ByVal hIMC As Long) As Long
' ■ウィンドウ操作関数
' 指定ウィンドウの属性(プロシージャ)を書き換える
#If Win64 Then
Private Declare PtrSafe Function SetWindowLongPtr Lib "USER32.dll" _
Alias "SetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
#Else
Private Declare PtrSafe Function SetWindowLongPtr Lib "USER32.dll" _
Alias "SetWindowLongA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
#End If
' Windowsメッセージを指定のウィンドウプロシージャに渡す(サブクラス化)
Private Declare PtrSafe Function CallWindowProc Lib "USER32.dll" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As LongPtr, _
ByVal hWnd As LongPtr, _
ByVal Msg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
' ウィンドウハンドルの取得
Private Declare PtrSafe Function FindWindow Lib "USER32.dll" _
Alias "FindWindowA" _
(ByVal lpClassName As Any, _
ByVal lpWindowName As Any) As Long
' 子ウィンドウのハンドルを取得(位置は利用しない)
Private Declare PtrSafe Function ChildWindowFromPoint Lib "USER32.dll" _
(ByVal hWndParent As LongPtr, _
ByVal xPoint As Long, _
ByVal yPoint As Long) As Long
#Else
' ■IME,Ponetic操作関連関数
' 変換中の文字列の情報を取得
Private Declare Function ImmGetCompositionString Lib "IMM32.dll" _
Alias "ImmGetCompositionStringA" _
(ByVal hIMC As Long, _
ByVal dw As Long, _
ByRef lpv As Any, _
ByVal dw2 As Long) As Long
' IMEのOpenステータスを取得
Private Declare Function ImmGetOpenStatus Lib "IMM32.dll" _
(ByVal hIMC As Long) As Long
' IMEのハンドルを取得
Private Declare Function ImmGetContext Lib "IMM32.dll" _
(ByVal hWnd As Long) As Long
' 取得したIMEのハンドルを解放
Private Declare Function ImmReleaseContext Lib "IMM32.dll" _
(ByVal hWnd As Long, _
ByVal hIMC As Long) As Long
' ■ウィンドウ操作関数
' 指定ウィンドウの属性(プロシージャ)を書き換える
Private Declare Function SetWindowLong Lib "USER32.dll" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
' Windowsメッセージを指定のウィンドウプロシージャに渡す(サブクラス化)
Private Declare Function CallWindowProc Lib "USER32.dll" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
' ウィンドウハンドルの取得
Private Declare Function FindWindow Lib "USER32.dll" _
Alias "FindWindowA" _
(ByVal lpClassName As Any, _
ByVal lpWindowName As Any) As Long
' 子ウィンドウのハンドルを取得(位置は利用しない)
Private Declare Function ChildWindowFromPoint Lib "USER32.dll" _
(ByVal hWndParent As Long, _
ByVal xPoint As Long, _
ByVal yPoint As Long) As Long
#End If
'-------------------------------------------------
' フォーム側情報の格納関数
Private g_objSrcTextBox As MSForms.TextBox ' 日本語入力TextBox
Private g_objDstTextBox As MSForms.TextBox ' フリガナをセットするTextBox
#If VBA7 Then
Private g_lngSubHwnd As LongPtr ' フォーム上サブウィンドウのハンドル
Private g_lngPrevWndFunc As LongPtr ' 直前のウィンドウプロシージャ
#Else
Private g_lngSubHwnd As Long ' フォーム上サブウィンドウのハンドル
Private g_lngPrevWndFunc As Long ' 直前のウィンドウプロシージャ
#End If
Private g_blnPoneticSW As Boolean ' 処理開始スイッチ
Private g_blnDupSW As Boolean ' 処理輻輳抑制スイッチ
'***************************************************************************************************
' ■■■ 公開プロシージャ(Public) ■■■
'***************************************************************************************************
'* 処理名 ：GP_PoneticInitialize
'* 機能 ：フリガナ監視の初期化
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：Arg1 = ユーザーフォーム(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月20日
'* 作成者 ：井上 治
'* 更新日 ：2019年11月04日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Public Sub GP_PoneticInitialize(objForm As MSForms.UserForm)
'-----------------------------------------------------------------------------------------------
#If VBA7 Then
Dim lngHwnd As LongPtr
Dim lngHwnd_Sub As LongPtr
#Else
Dim lngHwnd As Long
Dim lngHwnd_Sub As Long
#End If
' フォームウィンドウのハンドルを取得
lngHwnd = FindWindow("ThunderDFrame", objForm.Caption)
' フォーム上の透明サブウィンドウのハンドルを取得
lngHwnd_Sub = ChildWindowFromPoint(lngHwnd, 0&, 0&)
' IMEフリガナ監視開始処理
Call GP_StartPonetic(lngHwnd_Sub)
End Sub
'***************************************************************************************************
'* 処理名 ：GP_PoneticInitialize
'* 機能 ：フリガナ監視の初期化
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月20日
'* 作成者 ：井上 治
'* 更新日 ：2020年01月07日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Public Sub GP_PoneticTerminate()
'-----------------------------------------------------------------------------------------------
' 現在｢監視中｣か判断
If g_blnPoneticSW = True Then
' 直前のWindowProcessがあるか
If ((g_lngPrevWndFunc <> 0&) And (g_lngSubHwnd <> 0&)) Then
' 直前のWindowProcessを呼び戻す(サブクラス化終了)
#If VBA7 Then
SetWindowLongPtr g_lngSubHwnd, GWL_WNDPROC, g_lngPrevWndFunc
#Else
SetWindowLong g_lngSubHwnd, GWL_WNDPROC, g_lngPrevWndFunc
#End If
DoEvents
End If
g_lngPrevWndFunc = 0&
g_lngSubHwnd = 0&
' 対象TextBoxの解放
Set g_objSrcTextBox = Nothing
Set g_objDstTextBox = Nothing
' 終了
g_blnPoneticSW = False
End If
End Sub
'***************************************************************************************************
'* 処理名 ：GP_PoneticSetEdit
'* 機能 ：フリガナ処理TextBoxの設定
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：Arg1 = 漢字入力テキストボックス(Object)
'* Arg2 = フリガナ表示テキストボックス(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月20日
'* 作成者 ：井上 治
'* 更新日 ：2019年11月04日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Public Sub GP_PoneticSetEdit(objTxtSrc As MSForms.TextBox, objTxtDest As MSForms.TextBox)
'-----------------------------------------------------------------------------------------------
' 対象TextBoxをモジュールレベル変数に格納
Set g_objSrcTextBox = objTxtSrc
Set g_objDstTextBox = objTxtDest
End Sub
'***************************************************************************************************
'* 処理名 ：GP_PoneticResetEdit
'* 機能 ：フリガナ処理TextBoxの解除
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月20日
'* 作成者 ：井上 治
'* 更新日 ：2020年01月07日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Public Sub GP_PoneticResetEdit()
'-----------------------------------------------------------------------------------------------
' フリガナの初期化判定
If Not ((g_objSrcTextBox Is Nothing) And (g_objDstTextBox Is Nothing)) Then
' 漢字項目がブランクならフリガナもブランクにする
If g_objSrcTextBox.Text = "" Then g_objDstTextBox.Text = ""
End If
' 対象TextBoxの解放
Set g_objSrcTextBox = Nothing
Set g_objDstTextBox = Nothing
End Sub
'***************************************************************************************************
' ■■■ サブ処理(Private) ■■■
'***************************************************************************************************
'* 処理名 ：GP_StartPonetic
'* 機能 ：IMEフリガナ監視開始
'---------------------------------------------------------------------------------------------------
'* 返り値 ：(なし)
'* 引数 ：Arg1 = ウィンドウハンドル(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月20日
'* 作成者 ：井上 治
'* 更新日 ：2019年11月04日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：VBA7判定により2つに別れている
'***************************************************************************************************
#If VBA7 Then
Private Sub GP_StartPonetic(lngHwnd As LongPtr)
'-----------------------------------------------------------------------------------------------
' Terminateを忘れている場合の処理
If g_blnPoneticSW = True Then GP_PoneticTerminate
' フォームのサブウィンドウのハンドルをモジュール変数に格納
g_lngSubHwnd = lngHwnd
' モジュールレベル変数の初期化
Set g_objSrcTextBox = Nothing
Set g_objDstTextBox = Nothing
g_lngPrevWndFunc = 0&
' ハンドルが有効か
If g_lngSubHwnd <> 0& Then
' IMEフリガナ監視起動(サブクラス化開始)
g_lngPrevWndFunc = SetWindowLongPtr(g_lngSubHwnd, _
GWL_WNDPROC, _
AddressOf FP_PoneticWindowProc)
DoEvents
End If
' ｢監視中｣のスイッチセット
g_blnPoneticSW = True
End Sub
#Else
Private Sub GP_StartPonetic(lngHwnd As Long)
'-----------------------------------------------------------------------------------------------
' Terminateを忘れている場合の処理
If g_blnPoneticSW = True Then GP_PoneticTerminate
' フォームのサブウィンドウのハンドルをモジュール変数に格納
g_lngSubHwnd = lngHwnd
' モジュールレベル変数の初期化
Set g_objSrcTextBox = Nothing
Set g_objDstTextBox = Nothing
g_lngPrevWndFunc = 0&
' ハンドルが有効か
If g_lngSubHwnd <> 0& Then
' IMEフリガナ監視起動(サブクラス化開始)
g_lngPrevWndFunc = SetWindowLong(g_lngSubHwnd, _
GWL_WNDPROC, _
AddressOf FP_PoneticWindowProc)
DoEvents
End If
' ｢監視中｣のスイッチセット
g_blnPoneticSW = True
End Sub
#End If
'***************************************************************************************************
'* 処理名 ：FP_PoneticWindowProc
'* 機能 ：ウィンドウ処理(IMEフリガナ監視起動)(CallBack)
'---------------------------------------------------------------------------------------------------
'* 返り値 ：ウィンドウハンドル(Long)
'* 引数 ：Arg1 = ウィンドウハンドル(Long)
'* Arg2 = メッセージ(Long)
'* Arg3 = wParam(Long)
'* Arg4 = lParam(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月20日
'* 作成者 ：井上 治
'* 更新日 ：2019年11月04日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：VBA7判定により2つに別れている
'***************************************************************************************************
#If VBA7 Then
Private Function FP_PoneticWindowProc(ByVal lngHwnd As LongPtr, _
ByVal lngMsg As Long, _
ByVal lngwParam As Long, _
ByVal lnglParam As Long) As LongPtr
'-----------------------------------------------------------------------------------------------
Dim lngHIMC As Long
Dim lngSize As Long
Dim tblByte() As Byte
Dim strTEXT As String
Dim strText1 As String
Dim strText2 As String
Dim strFurigana As String
Dim lngMode As Long
' 処理輻輳でないか
If g_blnDupSW = False Then
g_blnDupSW = True
' テキストボックスの指定があるか
If Not ((g_objSrcTextBox Is Nothing) And (g_objDstTextBox Is Nothing)) Then
Select Case lngMsg
' IME入力中にフリガナを得る
Case WM_IME_COMPOSITION
' IMEのハンドルを取得
lngHIMC = ImmGetContext(lngHwnd)
' 変換中の文字列のサイズを取得
lngSize = ImmGetCompositionString(lngHIMC, _
GCS_RESULTSTR, _
ByVal 0&, 0&)
ReDim tblByte(lngSize)
' 変換中の文字列を取得(バイト配列)
Call ImmGetCompositionString(lngHIMC, _
GCS_RESULTSTR, _
tblByte(0), lngSize)
' バイト配列をテキストに変換
strTEXT = tblByte()
strText1 = StrConv(strTEXT, vbUnicode)
' 入力された文字があるか判断
If Not strText1 = vbNullString Then
' 変換中の文字列のサイズを取得
lngSize = ImmGetCompositionString(lngHIMC, _
GCS_RESULTREADSTR, _
ByVal 0&, 0&)
ReDim tblByte(lngSize)
' 変換中の文字列を取得(バイト配列)
Call ImmGetCompositionString(lngHIMC, _
GCS_RESULTREADSTR, _
tblByte(0), lngSize)
' バイト配列をテキストに変換
strTEXT = tblByte()
strText2 = StrConv(strTEXT, vbUnicode)
' 追加する文字種の判断
If FP_CheckString(StrConv(strText1, vbNarrow)) Then
strTEXT = strText1
Else
strTEXT = strText2
End If
' 追加テキストを作成
strFurigana = StrConv(Left$(strTEXT, Len(strTEXT) - 1), _
g_cnsConvMode)
' 挿入位置を判断(カーソル位置=中途での選択は末尾に追加となる)
If g_objSrcTextBox.SelStart > 0 Then
' 末尾に追加
g_objDstTextBox.Text = g_objDstTextBox.Text & strFurigana
Else
' 先頭に追加
g_objDstTextBox.Text = strFurigana & g_objDstTextBox.Text
End If
End If
' 取得したIMEのハンドルを解放
ImmReleaseContext lngHwnd, lngHIMC
'半角英数(直接入力)
Case WM_CHAR
' IMEのハンドルを取得
lngHIMC = ImmGetContext(lngHwnd)
' 半角入力モード
If ImmGetOpenStatus(lngHIMC) = 0& Then
' 制御キャラクタは無視
If lngwParam >= 32 Then
' 変換モードが全角なら全角に変換
If g_cnsConvMode = vbNarrow Then
g_objDstTextBox.Text = g_objDstTextBox.Text & _
Chr$(lngwParam)
Else
g_objDstTextBox.Text = g_objDstTextBox.Text & _
StrConv(Chr$(lngwParam), vbWide)
End If
End If
End If
' 取得したIMEのハンドルを解放
Call ImmReleaseContext(lngHwnd, lngHIMC)
'操作キー(連動消去)
Case WM_KEYUP
If ((lngwParam = vbKeyBack) Or _
(lngwParam = vbKeyDelete)) Then ' キーでの削除監視
If g_objSrcTextBox.Text = "" Then
g_objDstTextBox.Text = ""
End If
End If
End Select
End If
g_blnDupSW = False
End If
' 自身のウィンドウプロシージャを呼び出す
FP_PoneticWindowProc = CallWindowProc(g_lngPrevWndFunc, _
lngHwnd, _
lngMsg, _
lngwParam, _
lnglParam)
End Function
#Else
Private Function FP_PoneticWindowProc(ByVal lngHwnd As Long, _
ByVal lngMsg As Long, _
ByVal lngwParam As Long, _
ByVal lnglParam As Long) As Long
'-----------------------------------------------------------------------------------------------
Dim lngHIMC As Long
Dim lngSize As Long
Dim tblByte() As Byte
Dim strTEXT As String
Dim strText1 As String
Dim strText2 As String
Dim strFurigana As String
Dim lngMode As Long
' 処理輻輳でないか
If g_blnDupSW = False Then
g_blnDupSW = True
' テキストボックスの指定があるか
If Not ((g_objSrcTextBox Is Nothing) And (g_objDstTextBox Is Nothing)) Then
Select Case lngMsg
' IME入力中にフリガナを得る
Case WM_IME_COMPOSITION
' IMEのハンドルを取得
lngHIMC = ImmGetContext(lngHwnd)
' 変換中の文字列のサイズを取得
lngSize = ImmGetCompositionString(lngHIMC, _
GCS_RESULTSTR, _
ByVal 0&, 0&)
ReDim tblByte(lngSize)
' 変換中の文字列を取得(バイト配列)
Call ImmGetCompositionString(lngHIMC, _
GCS_RESULTSTR, _
tblByte(0), lngSize)
' バイト配列をテキストに変換
strTEXT = tblByte()
strText1 = StrConv(strTEXT, vbUnicode)
' 入力された文字があるか判断
If Not strText1 = vbNullString Then
' 変換中の文字列のサイズを取得
lngSize = ImmGetCompositionString(lngHIMC, _
GCS_RESULTREADSTR, _
ByVal 0&, 0&)
ReDim tblByte(lngSize)
' 変換中の文字列を取得(バイト配列)
Call ImmGetCompositionString(lngHIMC, _
GCS_RESULTREADSTR, _
tblByte(0), lngSize)
' バイト配列をテキストに変換
strTEXT = tblByte()
strText2 = StrConv(strTEXT, vbUnicode)
' 追加する文字種の判断
If FP_CheckString(StrConv(strText1, vbNarrow)) Then
strTEXT = strText1
Else
strTEXT = strText2
End If
' 追加テキストを作成
strFurigana = StrConv(Left$(strTEXT, Len(strTEXT) - 1), _
g_cnsConvMode)
' 挿入位置を判断(カーソル位置=中途での選択は末尾に追加となる)
If g_objSrcTextBox.SelStart > 0 Then
' 末尾に追加
g_objDstTextBox.Text = g_objDstTextBox.Text & strFurigana
Else
' 先頭に追加
g_objDstTextBox.Text = strFurigana & g_objDstTextBox.Text
End If
End If
' 取得したIMEのハンドルを解放
ImmReleaseContext lngHwnd, lngHIMC
'半角英数(直接入力)
Case WM_CHAR
' IMEのハンドルを取得
lngHIMC = ImmGetContext(lngHwnd)
' 半角入力モード
If ImmGetOpenStatus(lngHIMC) = 0& Then
' 制御キャラクタは無視
If lngwParam >= 32 Then
' 変換モードが全角なら全角に変換
If g_cnsConvMode = vbNarrow Then
g_objDstTextBox.Text = g_objDstTextBox.Text & _
Chr$(lngwParam)
Else
g_objDstTextBox.Text = g_objDstTextBox.Text & _
StrConv(Chr$(lngwParam), vbWide)
End If
End If
End If
' 取得したIMEのハンドルを解放
Call ImmReleaseContext(lngHwnd, lngHIMC)
'操作キー(連動消去)
Case WM_KEYUP
If ((lngwParam = vbKeyBack) Or _
(lngwParam = vbKeyDelete)) Then ' キーでの削除監視
If g_objSrcTextBox.Text = "" Then
g_objDstTextBox.Text = ""
End If
End If
End Select
End If
g_blnDupSW = False
End If
' 自身のウィンドウプロシージャを呼び出す
FP_PoneticWindowProc = CallWindowProc(g_lngPrevWndFunc, _
lngHwnd, _
lngMsg, _
lngwParam, _
lnglParam)
End Function
#End If
'***************************************************************************************************
'* 処理名 ：FP_CheckString
'* 機能 ：全て半角文字かチェック
'---------------------------------------------------------------------------------------------------
'* 返り値 ：チェック成否(Boolean)
'* 引数 ：Arg1 = 対象テキスト(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 ：2003年08月20日
'* 作成者 ：井上 治
'* 更新日 ：2003年08月20日
'* 更新者 ：井上 治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_CheckString(strTEXT As String) As Boolean
'-----------------------------------------------------------------------------------------------
Dim IX As Long
Dim lngCode As Long
FP_CheckString = False
For IX = 1 To Len(strTEXT)
lngCode = Asc(Mid$(strTEXT, IX, 1))
' 全角文字であればFalseで脱出
If ((lngCode < 0) Or (lngCode > 255)) Then Exit Function
Next IX
FP_CheckString = True
End Function
'------------------------------------------<< End of Source >>--------------------------------------
これだけの記述でふりがな自動入力は実現します。
なお、ワークシートでの「ふりがな自動入力」は、Excel自身に「PHONETIC関数」があるため、はるかに簡単に実現します。但し、計算式を置いてしまうとふりがな自身の修正ができないため、シートのChangeイベントを利用して入力セルに転記させる必要があります。
 |
←HURIGANA1.zip (46KB) |