Excel VBAに効く Vitamin E
ExcelのUserFormテキストボックスに入力した漢字のフリガナを取得
ExcelではPHONETIC関数でCellに入力した漢字のフリガナを取得できますが、UserFormには同等の関数はありません。Win32APIを使ってUserFormでフリガナを取得する関数を作成しました。
'(標準モジュール)
Option Explicit

'最前面のウィンドウのハンドルを取得
Declare Function GetForegroundWindow Lib "user32.dll" () As Long

'Zオーダーのトップ位置にある子ウィンドウのハンドルを取得
Declare Function GetTopWindow Lib "user32.dll" (ByVal hWnd As Long) As Long

'指定ウィンドウの入力コンテキストのハンドルを取得
Declare Function ImmGetContext Lib "IMM32" (ByVal hWnd As Long) As Long

'(ImmGetCompositionString)
Public Const GCS_COMPATTR = &H10 '入力文字列の属性
Public Const GCS_COMPCLAUSE = &H20 '入力文字列の文節情報
Public Const GCS_COMPREADATTR = &H2 '読みの属性
Public Const GCS_COMPREADCLAUSE = &H4 '読みの文節情報
Public Const GCS_COMPREADSTR = &H1 '読みの文字列
Public Const GCS_COMPSTR = &H8 '入力文字列
Public Const GCS_CURSORPOS = &H80 '入力文字列内のカーソル位置
Public Const GCS_DELTASTART = &H100 '入力文字列内の変更開始位置
Public Const GCS_RESULTCLAUSE = &H1000 '確定文字列の文節情報
Public Const GCS_RESULTREADCLAUSE = &H400 '読みの文字列の文節情報
Public Const GCS_RESULTREADSTR = &H200 '読みの文字列
Public Const GCS_RESULTSTR = &H800 '確定文字列
'入力テキストに関する情報を取得
Declare Function ImmGetCompositionString Lib "IMM32" Alias "ImmGetCompositionStringA" (ByVal hIMC As Long, ByVal dwIndex As Long, ByVal lpBuf As String, ByVal dwBufLen As Long) As Long

'指定ウィンドウの入力コンテキストのハンドルを解放
Declare Function ImmReleaseContext Lib "IMM32" (ByVal hWnd As Long, ByVal hIMC As Long) As Long

Function LsGetChildWindow() As Long
'テキストボックスのウィンドウハンドル取得
'UserForm内の全てのコントロールのウィンドウハンドルは同じ値となる。
 
 Dim hWnd As Long

  '最前面のUserFormのウィンドウハンドルを取得
  hWnd = GetForegroundWindow()
  '最前面のUserFormの子ウィンドウハンドルを取得
  LsGetChildWindow = GetTopWindow(hWnd)
End Function

Function LsGetPhonetic() As String
'フリガナ取得
'テキストボックスのChangeイベントに指定して使用する
  Dim rc As Long
  Dim hIMC As Long
  Dim lpBuf As String * 256
  Dim wKana As String
  Dim hWnd As Long

  'テキストボックスのウィンドウハンドル取得
  hWnd = LsGetChildWindow()
  'テキストボックスの入力コンテキストのハンドルを取得
  hIMC = ImmGetContext(hWnd)
  'テキストボックスに入力された読みの文字列を取得
  rc = ImmGetCompositionString(hIMC, GCS_RESULTREADSTR, ByVal lpBuf, Len(lpBuf))
  'テキストボックスの入力コンテキストを解放
  rc = ImmReleaseContext(hWnd, hIMC)
  '文字列からNull文字を削除
  wKana = LsReplace(lpBuf, vbNullChar, "")
  '文字列からスペースを削除
  If wKana <> " " Then
    wKana = LsReplace(wKana, " ", "")
  End If
  LsGetPhonetic = wKana
End Function

Function LsReplace(ByVal 依頼文字列 As String, 置換対象文字列 As String, 置換文字列 As String) As String
'文字列置換
  Dim i As String
  Dim w As String

  i = InStr(依頼文字列, 置換対象文字列)
  Do Until i < 1
    w = w & Left$(依頼文字列, i - 1) & 置換文字列
    依頼文字列 = Mid$(依頼文字列, i + Len(置換対象文字列))
    i = InStr(依頼文字列, 置換対象文字列)
  Loop
  LsReplace = w & 依頼文字列
End Function

'(UserForm)この例ではバックスペースキーを押すたびに最後のカナが表示されてしまう。

Option Explicit

Private Sub TextBox1_Change()
  Dim w As String

  w = LsGetPhonetic()
  Me!TextBox2.Value = Me!TextBox2.Value & w
End Sub

'(UserForm)改訂版(UPD:03/01/17)

Option Explicit

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  'Shift、Ctrlキーを押しただけで反応することを避ける
  If Shift <> 0 Then Exit Sub

  TextBox3.Text = LsGetPhonetic()
End Sub

Private Sub TextBox3_Change()
  With TextBox2
    '出力位置を既存のテキストの最後尾に置く
.    SelStart = Len(.Text)
    'ダミーのテキストをコピー
.    SelText = TextBox3.Text
  End With
End Sub
フリガナ.xlsのダウンロード(furigana.LZH)

(UPD:03/01/16.17)