Attribute VB_Name = "Sheet1"
'■　マクロ５００連発＜第２段＞
'
'　決められたセルのIME（日本語入力モード）の状態を設定する
'  (イベントプロシージャ)
'
'  Copyright(C) 2000 Sunago
'
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    '/* 入力規則の日本語入力機能を使って設定する */
    Target.Validation.Delete
    Target.Validation.Add Type:=xlValidateInputOnly
    Select Case Target.Cells(1, 1).Address(False, False)
        Case "B2"
            Target.Validation.IMEMode = xlIMEModeNoControl
        Case "B3"
            Target.Validation.IMEMode = xlIMEModeOn
        Case "B4"
            Target.Validation.IMEMode = xlIMEModeOff
        Case "B5"
            Target.Validation.IMEMode = xlIMEModeDisable
        Case "B6"
            Target.Validation.IMEMode = xlIMEModeHiragana
        Case "B7"
            Target.Validation.IMEMode = xlIMEModeKatakana
        Case "B8"
            Target.Validation.IMEMode = xlIMEModeKatakanaHalf
        Case "B9"
            Target.Validation.IMEMode = xlIMEModeAlphaFull
        Case "B10"
            Target.Validation.IMEMode = xlIMEModeAlpha
    End Select
    
    '/* 自作関数(API使用)を用いてIMEの状態を設定する */
    Select Case Target.Cells(1, 1).Address(False, False)
        'ひらがな
        Case "D2"
            Call IMEControl(IME_CMODE_FULLSHAPE + IME_CMODE_JAPANESE)
        '全角英数
        Case "D3"
            Call IMEControl(IME_CMODE_FULLSHAPE + IME_CMODE_ALPHANUMERIC)
        '半角英数
        Case "D4"
            Call IMEControl(IME_CMODE_ALPHANUMERIC)
        '全角カナ
        Case "D5"
            Call IMEControl(IME_CMODE_FULLSHAPE + IME_CMODE_KATAKANA)
        '半角カナ
        Case "D6"
            Call IMEControl(IME_CMODE_KATAKANA)
    End Select
End Sub


Attribute VB_Name = "IMM32API"
'■　マクロ５００連発＜第２段＞
'
'　決められたセルのIME（日本語入力モード）の状態を設定する
'　（IMM32API定義)
'
'  Copyright(C) 2000 Sunago
'
Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ImmGetContext Lib "imm32.dll" _
        (ByVal hWnd As Long) As Long
Private Declare Function ImmReleaseContext Lib "imm32.dll" _
        (ByVal hWnd As Long, ByVal hIMC As Long) As Long
Private Declare Function ImmGetOpenStatus Lib "imm32.dll" _
        (ByVal hIMC As Long) As Long
Private Declare Function ImmSetOpenStatus Lib "imm32.dll" _
        (ByVal hIMC As Long, ByVal b As Long) As Long
Private Declare Function ImmSetConversionStatus Lib "imm32.dll" _
        (ByVal hIMC As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long

'/* IME Conversion Mode Values */
Public Const IME_CMODE_ALPHANUMERIC = &H0
Public Const IME_CMODE_NATIVE = &H1
Public Const IME_CMODE_JAPANESE = IME_CMODE_NATIVE
Public Const IME_CMODE_CHINESE = IME_CMODE_NATIVE
Public Const IME_CMODE_HANGEUL = IME_CMODE_NATIVE
Public Const IME_CMODE_KATAKANA = &H2
Public Const IME_CMODE_LANGUAGE = &H3
Public Const IME_CMODE_FULLSHAPE = &H8
Public Const IME_CMODE_ROMAN = &H10
Public Const IME_CMODE_CHARCODE = &H20
Public Const IME_CMODE_SOFTKBD = &H80
Public Const IME_CMODE_HANJACONVERT = &H40
Public Const IME_CMODE_NOCONVERSION = &H100
Public Const IME_CMODE_EUDC = &H200
Public Const IME_CMODE_SYMBOL = &H400
'/* IME Sentence Mode Values */
Private Const IME_SMODE_NONE = &H0
Private Const IME_SMODE_PLAURALCLAUSE = &H1
Private Const IME_SMODE_SINGLECONVERT = &H2
Private Const IME_SMODE_AUTOMATIC = &H4
Private Const IME_SMODE_PHRASEPREDICT = &H8

'■　IMEの状態を設定する関数(IMM32)　■
Public Sub IMEControl(nMode As Long)
Dim hWnd As Long
Dim hIMC As Long
Dim ret As Long
      
    'EXCELアプリケーションのウィンドウハンドルを取得する
    hWnd = FindWindow("XLMAIN", Application.Caption)
    '入力コンテキストを取得する
    hIMC = ImmGetContext(hWnd)
    'IMEの状態を取得する
    If ImmGetOpenStatus(hIMC) = 0 Then
        'IMEをオープンする
        ret = ImmSetOpenStatus(hIMC, True)
    End If
    'IMEのモードを設定する
    ret = ImmSetConversionStatus(hIMC, nMode, IME_SMODE_AUTOMATIC)
    '入力コンテキストを開放する
    ret = ImmReleaseContext(hWnd, hIMC)
End Sub