エクセル使用時のIMEの設定について

質問

”単語/用例の登録”機能を利用して、”読み”に数字の”1”を登録、”語句”に”炭俵灰之介”を
登録する。このままだと、任意のセルに”１”を入力→スペースキーで変換→ENTERで確定
→ENTERで直下のセルに移動、となりますが、これを、特定のセル範囲、例えば、D5からD10
のみにおいて、1を入力→他の変換候補を表示させることなく、ENTERで確定、同時に直下の
セルに移動できるようにしたいのですが、なにか方法はあるでしょうか。
VLOOKUP関数を使用すると、検索用の数字を入力するセルと、検索結果を表示するセルが
別になり、画面が煩雑に思われるので、このような方法が可能かどうか考えているところですが
検索用の数字を入力するセルと、検索結果を表示するセルを同じにする方法はなにか
あるでしょうか。
ご教授お願いいたします。

回答No.4

cj_mover · ベストアンサー

＃３、ｃｊです。
> その、すこしが難しい
よくご存じのようで、安心しました。
一応、仕様等私好みで整理してみました。
＃好きでやってるので、気にしないで下さいね。あのままじゃ余りにもアレなので。
インデックスをセル値に指定するだけで事足りる話だったなら、それはそれでいいので。

' ' ===ThisWorkbookモジュール===
Option Explicit
' ' ============================ 7767828we2
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
　　Sheets("Sheet1").FrmTBox.Visible = False '◆ Sheet名を指定
End Sub
' ' ============================

' ' ======Sheet モジュール======
Option Explicit
Private aList ' List配列
Private nUB As Long ' List配列のサイズ
Private n As Long ' List配列用インデックス
Private Const S_REF = "D5:D10" '◆処理対象範囲を参照文字列指定
' ' ============================ 7767828shEv
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　If Intersect(Target, Range(S_REF)) Is Nothing Or Target.Count > 1 Then
　　　　If FrmTBox.Visible Then FrmTBox.Visible = False
　　Else
　　　　Call ActTBox(Target)
　　End If
End Sub
' ' ----------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　If Intersect(Target, Range(S_REF)) Is Nothing Then Exit Sub
　　Cancel = True
　　Call ActTBox(Target)
End Sub
' ' ============================ 7767828tbEv
Private Sub FrmTBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　　With FrmTBox
　　　　Select Case KeyCode
　　　　Case 27: Application.OnTime Now(), Me.Name & ".HideTBox" ' ▼"ESC"
　　　　Case 37: ActiveCell.Offset(, -1).Select ' ▼"←"
　　　　Case 38: ActiveCell(0).Select ' ▼"↑"
　　　　Case 39: ActiveCell(1, 2).Select ' ▼"→"
　　　　Case 40: ActiveCell(2).Select ' ▼"↓"
　　　　End Select
　　End With
End Sub
' ' ----------------------------
Private Sub FrmTBox_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error GoTo CrArr_
　　nUB = UBound(aList)
On Error GoTo 0
　　With FrmTBox
　　　　Select Case KeyCode
　　　　Case 48 To 57, 96 To 105: Call ValVal(n & KeyCode Mod 48) ' ▲"0" To "9", "0" To "9"(NumLockedTenKey)
　　　　Case 107, 187: Call ValVal(n + 1) ' ▲Shift+"+", "+"(TenKey)
　　　　Case 109, 189: Call ValVal(n - 1)　　' ▲"-", "-"(TenKey)
　　　　Case 8: Call ValVal(n \ 10)　　' ▲"BACKSPACE"
　　　　Case 46: Call ValVal(0)　　' ▲"DEL"
　　　　Case 9, 13　　' ▲"TAB", "ENTER"
　　　　　　If .Value <> "" Then ActiveCell.Value = .Value
　　　　　　If Shift Then ' "SHIFT"
　　　　　　　　ActiveCell(0).Select
　　　　　　Else
　　　　　　　　ActiveCell(2).Select
　　　　　　End If
　　　　End Select
　　End With
　　DoEvents
Exit Sub
CrArr_:
　　Call SetList
Resume
End Sub
' ' ============================ 7767828subR
Sub SetList() ' ◆ List内容を一次元配列で設定。方法、内容は運用に合わせて適宜。Null値不可。
　　aList = VBA.Array(Empty, "炭俵灰之介", "Alfred", "Benjamin", "Charlie", "David", "Edward" _
　　　　　　　　　　, "Frank", "George", "Harry", "Isaac", "Jack", Empty, "King", "London" _
　　　　　　　　　　, "Mary", "Nellie", "Oliver", "Peter", "Queen", "Robert", "Samuel", "Tommy")
End Sub
' ' ----------------------------
Sub ActTBox(Target As Range) ' FrmTBox 初期化 位置設定 表示 等
　　n = 0
　　With FrmTBox
　　　　.Object.Value = Empty
　　　　.Object.IMEMode = fmIMEModeOff
　　　　.Top = Target(1).Top
　　　　.Left = Target(1).Left
　　　　.Activate
　　　　If Not .Visible Then .Visible = True
　　End With
End Sub
' ' ----------------------------
Private Sub HideTBox() ' ESC 処理
　　DoEvents: DoEvents
　　FrmTBox.Visible = False
　　ActiveCell.Activate
End Sub
' ' ----------------------------
Sub ValVal(nn As Long) ' List用インデックス n と FrmTBox.Value の管理
　　If nn < 0 Then nn = 0
　　n = nn
　　With FrmTBox
　　　　If n > nUB Then ' 割り当ての無いインデックスは数値のまま
　　　　　　.Value = n
　　　　ElseIf n = 0 Then
　　　　　　.Value = Empty
　　　　ElseIf aList(n) = "" Then
　　　　　　.Value = n
　　　　Else
　　　　　　.Value = aList(n)
　　　　End If
　　End With
End Sub
' ' ============================
' ' ============================ 7767828prep
Private Sub Prep7767828() ' TextBox 初期設定 利用開始時に一度だけ実行
　　With OLEObjects.Add(ClassType:="Forms.TextBox.1")
　　　　With .Object
　　　　　　.BackColor = &HC0FFFF
　　　　　　.SpecialEffect = fmSpecialEffectFlat
　　　　End With
　　　　.Height = Range("D5").Height '◆
　　　　.Width = Range("D5").Width '◆
　　　　.Name = "FrmTBox"
　　　　.PrintObject = False
　　　　.Visible = False
　　End With
End Sub
' ' ===========================

お礼

回答　ありがとうございます
お礼が遅くなり、失礼しました

このマクロは難しすぎます。
でも、最初の行から順に理解していけば、いつかは・・・・

回答No.3

cj_mover

' ' =========ThisWorkbookモジュール=========
' ' ※　Sheet名を正しく指定してください　※
Option Explicit
' ' ---------------------------------------- 7767828we1
Private Sub Workbook_BeforeClose(Cancel As Boolean)
　　Sheets("Sheet1").OleTxtBx.Visible = False
End Sub
' ' ---------------------------------------- 7767828we2
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
　　Sheets("Sheet1").OleTxtBx.Visible = False
End Sub
' ' =======以上ThisWorkbookモジュール=======

' ' ============Sheet モジュール============
Option Explicit
Private n As Long
Private aList
' ' ---------------------------------------- 7767828se1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　If Intersect(Target, Range("D5:D10")) Is Nothing Or Target.Count > 1 Then ' ◆
　　　　If OleTxtBx.Visible Then
　　　　　　n = Empty
　　　　　　OleTxtBx.Visible = False
　　　　End If
　　Else
　　　　Call SetTxtBox(Target)
　　End If
End Sub
' ' ---------------------------------------- 7767828se2
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　If Intersect(Target, Range("D5:D10")) Is Nothing Then Exit Sub ' ◆
　　Cancel = True
　　Call SetTxtBox(Target)
End Sub
' ' ---------------------------------------- 7767828sr
Sub SetTxtBox(Target As Range)　　' TextBox 初期設定
　　With OleTxtBx
　　　　.Top = Target(1).Top
　　　　.Left = Target(1).Left
　　　　.Height = Target(1).Height
　　　　.Width = Target(1).Width
　　　　.IMEMode = fmIMEModeOff
　　　　.Value = Empty
　　　　.Activate
　　　　If Not .Visible Then .Visible = True
　　End With
End Sub
' ' ---------------------------------------- 7767828te1
Private Sub OleTxtBx_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　　If KeyCode = 27 Then　　' "ESC"
　　　　n = Empty
　　　　' OleTxtBx.Visible = False
　　　　ActiveCell.Activate
　　End If
End Sub
' ' ---------------------------------------- 7767828te1
' ' 方向キーなど、未対応のキーがあります。未完成です。
Private Sub OleTxtBx_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　　Dim nUB As Long
On Error GoTo CrArr_
　　nUB = UBound(aList)
On Error GoTo 0
　　With OleTxtBx
　　　　Select Case KeyCode
　　　　Case 48 To 57, 96 To 105　　' 0 To 9, 0 To 9(NumLockedTenKey)
　　　　　　n = Val(n & KeyCode Mod 48)
　　　　　　If n > nUB Then
　　　　　　　　.Value = n
　　　　　　ElseIf aList(n) = "" Then
　　　　　　　　.Value = n
　　　　　　Else
　　　　　　　　.Value = aList(n)
　　　　　　End If
　　　　Case 9, 13　　' "TAB", "ENTER"
　　　　　　n = Empty
　　　　　　If .Value <> "" Then ActiveCell.Value = .Value
'　　　　　　ActiveCell.Value = .Value ' ' ←↑ as U like
　　　　　　If Shift Then ' "SHIFT"
　　　　　　　　If ActiveCell.Row = 5 Then .Visible = False ' ◆
　　　　　　　　ActiveCell(0).Select
　　　　　　Else
　　　　　　　　If ActiveCell.Row = 10 Then .Visible = False ' ◆
　　　　　　　　ActiveCell(2).Select
　　　　　　End If
　　　　Case 8, 46　　' "BACKSPACE", "DEL"
　　　　　　n = Empty
　　　　　　.Value = Empty
　　　　End Select
　　End With
　　Exit Sub
CrArr_: ' ' 一次元配列を設定します。方法、内容は運用に合わせて適宜。以下↓はダミー。
　　aList = VBA.Array(Empty, "炭俵灰之介", "Alfred", "Benjamin", "Charlie", "David", "Edward" _
　　　　　　　　　　, "Frank", "George", "Harry", "Isaac", "Jack", Empty, "King", "London" _
　　　　　　　　　　, "Mary", "Nellie", "Oliver", "Peter", "Queen", "Robert", "Samuel", "Tommy")
Resume
End Sub
' ' ==========以上Sheet モジュール==========

' ' ========初期設定（Sheet モジュール）========
' ' 利用開始時にこのプロシージャだけを貼り付け、一度だけ実行
Private Sub Prep7767828()　　' TextBox 初期設定
　　Dim oObj As OLEObject
　　Set oObj = Me.OLEObjects.Add(ClassType:="Forms.TextBox.1")
　　With oObj
　　　　With .Object
　　　　　　.BackColor = &HC0FFFF
　　　　　　.SpecialEffect = fmSpecialEffectFlat
　　　　End With
　　　　.Name = "OleTxtBx"
　　　　.PrintObject = False
　　　　.Visible = False
　　End With
End Sub
' ' ==============　初期設定　以上==============

こんにちは。お邪魔します。
アイデアひとつでトライした習作みたいなもの（完全ではない）です。

試す場合の手順
　新規のブックを用意して
　まずSheet1のシートモジュールにSub Prep7767828だけを貼りつけて実行
　Sub Prep7767828はもう不要なので削除
　Sheet1シートモジュールにシートモジュール用コードを貼り付け
　ThisWorkbookモジュールにThisWorkbookモジュール用コードを貼り付け
　名前を付けて保存

"ウィンドウ枠固定"、"フィルター"、"アウトライン"などを常時適用したシート、
セルを隠したり描画位置を遷移させるような機能、
などとの併用は、相性悪い、というか奨められません。
本当はUserFormにした方が動作安定します。

でもまあ、ご要望に近い気はしているので、
試して貰えれば仕様を固める足掛かり程度には役に立つんじゃないかな？と。

お礼

回答、ありがとうございます

マクロはどうにも手がつけかねています。
＞ご要望に近い気はしているので
はい、これをすこし変えれば、完成しそうですが、その、すこしが難しい。
でも、これを機会にマクロを勉強してみます。

回答No.2

MackyNo1

表示だけで良いなら、対象セル範囲を選択して右クリックし、「セルの書式設定」から表示形式を「ユーザー定義」にして、種類の欄に「[=1]"炭俵灰之介";[2]"2の時の文字列"」と入力してみてください。

お礼

回答、ありがとうございます

さっそく利用してみました。なんだか、拍子抜けするぐらい簡単にできました。
なんでも、やってみなくてはわからない、とはいうものの、教わらなくてはわからないことも
たくさんありますよね。

回答No.1

keithin

こんばんは。

＞D5からD10のみにおいて

これがご相談の核心部分という事ですか？

それならまず、ＩＭＥにはそういう器用なマネは出来ません。
またご相談の内容自体はエクセルの「オートコレクト」によって実現可能ですが、こちらも「特定のセル範囲」限定は不可能です。

出来ることその１）
＞1を入力→他の変換候補を表示させることなく、ENTERで確定、
＞同時に直下のセルに移動できるようにしたい

それがヤリタイ事であるのなら、次のようにしておくと出来ます。
（極めて限定的な機能なので、何でも自由にできるワケじゃありません。という意味です）

手順：
所定のセル範囲を選択
セルの書式設定の表示形式でユーザー定義を選び
[=1]"炭俵灰之介";G/標準
と設定しておく

出来ることその２）
シート名タブを右クリック、コードの表示を選ぶ
現れたシートに下記をコピー貼り付ける

private sub worksheet_change(byval Target as excel.range)
　dim h as range
　on error resume next

　for each h in application.intersect(target, range("D5:D10"))
　if h = 1 then
　　h = "炭俵灰之介"
　elseif h = "abc" then
　　h = 999
　end if
　next
end sub

ファイルメニューから終了してエクセルに戻る
所定のセルに所定の記入を行う。

＃参考
ご相談の書き振りが「１ならこれを記入」しかないので、ハードコードしています。
何か一覧表を別に用意できて、それぞれ対応する言葉に書き換えたいと言いたかったのでしたら、上述のようなマクロをちょっと応用すれば簡単に実現できます。特にフォローはしませんので、必要なら自力で挑戦してみて下さい。

お礼

回答　ありがとうございます

出来ることその１）を使わせていただきます。その2）のほうは、マクロの敷居が高くて・・・
でも、マクロを自在に使えれば、市販のソフトに負けないくらいのことができるそうで
マクロを勉強してみます。