[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ユーザーフォームでキーボードローマ字入力』（ひつじ）
ユーザーフォーム上に「A」〜「Z」までのアルファベットを表記したコマンドボタンとテキストボックスを一つ設置し、
「A」ボタンを押すとテキストボックスに「あ」と表示させ
「K」を押した後「A」を押すとテキストボックスに「か」と表示させ
「K」「Y」「A」と押した場合テキストボックスに「きゃ」と表示させる
(端的に言うとキーボードのローマ字入力をユーザーフォームのコマンドボタンで行いたい)マクロを組む場合、どのようなコードにすれば良いのでしょうか
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
Dim cLast As String
Sub test1()
With Sheets("Dialog1")
.EditBoxes(1).Text = ""
.Show
End With
End Sub
Sub test2()
Dim cw As String
With Sheets("Dialog1")
cw = .Buttons(Application.Caller).Characters.Text
Select Case cw
Case "A"
Select Case cLast
Case "": .EditBoxes(1).Text = .EditBoxes(1).Text & "あ"
Case "K": .EditBoxes(1).Text = .EditBoxes(1).Text & "か": cLast = ""
Case "KY": .EditBoxes(1).Text = .EditBoxes(1).Text & "きゃ": cLast = ""
Case "S": .EditBoxes(1).Text = .EditBoxes(1).Text & "さ": cLast = ""
Case "T"
Case "N"
Case "H"
Case "M"
Case "Y"
Case "R"
Case "W"
Case "G"
Case "Z"
Case "D"
Case "B"
Case "P"
Case Else
End Select
Case "I"
'…
Case "U"
'…
Case "E"
'…
Case "O"
'…
Case Else
cLast = cLast & cw
End Select
End With
End Sub
Sub 初回1回だけ実行()
Dim i As Long
Dim iX As Single
Dim iY As Single
With DialogSheets.Add
.Name = "Dialog1"
.DialogFrame.Characters.Text = " test"
.DialogFrame.Width = 312
.DialogFrame.Height = 108
.Buttons(1).Left = .DialogFrame.Left + 4
.Buttons(2).Left = .DialogFrame.Left + 4
.EditBoxes.Add .DialogFrame.Left + 8 + .Buttons(1).Width, .Buttons(1).Top, 240, 16
For i = 1 To 26
iX = .Buttons(1).Left + .Buttons(1).Width + 4 + ((i - 1) Mod 10) * 24
iY = .Buttons(1).Top + ((i - 1) \ 10 + 1) * 20
With .Buttons.Add(iX, iY, 24, 20)
.Name = "BT" & Format(i, "00")
.Characters.Text = Chr(64 + i)
.OnAction = "test2"
End With
Next i
End With
End Sub
使い方は、「初回1回だけ実行」を実行すると、シートが1つ追加されます。 この状態で test1 を実行してみてください。
タッチパネルのみの操作でも考えているのでしょうかね？ そうでなければ、面倒なだけです。
（???） 2020/09/23(水) 14:08
スクリーンキーボードではダメなんですかね？ （Why） 2020/09/23(水) 15:00
ユーザーフォームには、TextBox1 と TextBox2、と複数のコマンドボタンを配置 コマンドボタンのCaption はアルファベット一文字（キーボードのキーのイメージ）
・コマンドボタンをクリックすると、コマンドボタンのCaptionの文字がTextBox1に追加される ・TextBox1のTextが変更されると、TextBox2に カナ変換されて表示される
roma2kanaは、http://mikoyellowhome.web.fc2.com/index.htm の Excelノート 15-03 セルのデータ 56 カタカナをローマ字（アルファベット）に変換するには？
を使わせていただきました。
----------- UserForm ---------------- Dim KeyBtn(1 To 26) As clsKeyBtn
Private Sub UserForm_Initialize()
i = 1
For Each c In Me.Controls
If TypeName(c) = "CommandButton" Then
Set KeyBtn(i) = New clsKeyBtn
Set KeyBtn(i).btn = c
Set KeyBtn(i).TextLine = Me.TextBox1
i = i + 1
End If
Next
End Sub
Private Sub TextBox1_Change()
Me.TextBox2.Text = roma2kana(Me.TextBox1.Text)
End Sub
----------- クラスモジュール clsKeyBtn --------- Public WithEvents btn As MSForms.CommandButton
Public TextLine As MSForms.TextBox
Private Sub btn_Click()
TextLine.Text = TextLine.Text & Me.btn.Caption
End Sub
----------- 標準モジュール ----------
Function roma2kana(ByVal roma As String, Optional ByVal katakana As Boolean = True) As String
Dim i As Integer, j1 As Integer, j2 As Integer, k As Integer, index As Integer
Dim conv2 As Variant, conv1 As Variant, conv0 As Variant
Dim kanatbl(1 To 41), Pre As String
Dim retStr As String
conv2 = Array("by", "ch", "dy", "gy", "hy", "jy", "ky", "ly", "my", "nn", "ny", "py", "ry", "sh", "sy", "ts", "ty", "xy", "zy", "lt", "xt")
conv1 = Array("b", "d", "f", "g", "h", "j", "k", "l", "m", "n", "p", "r", "s", "t", "v", "w", "x", "y", "z")
conv0 = Array("a", "i", "u", "e", "o")
kanatbl(1) = Array("ア", "イ", "ウ", "エ", "オ")
kanatbl(2) = Array("バ", "ビ", "ブ", "ベ", "ボ")
kanatbl(3) = Array("ダ", "ヂ", "ヅ", "デ", "ド")
kanatbl(4) = Array("ファ", "フィ", "フ", "フェ", "フォ")
kanatbl(5) = Array("ガ", "ギ", "グ", "ゲ", "ゴ")
kanatbl(6) = Array("ハ", "ヒ", "フ", "ヘ", "ホ")
kanatbl(7) = Array("ジャ", "ジ", "ジュ", "ジェ", "ジョ")
kanatbl(8) = Array("カ", "キ", "ク", "ケ", "コ")
kanatbl(9) = Array("ァ", "ィ", "ゥ", "ェ", "ォ")
kanatbl(10) = Array("マ", "ミ", "ム", "メ", "モ")
kanatbl(11) = Array("ナ", "ニ", "ヌ", "ネ", "ノ")
kanatbl(12) = Array("パ", "ピ", "プ", "ペ", "ポ")
kanatbl(13) = Array("ラ", "リ", "ル", "レ", "ロ")
kanatbl(14) = Array("サ", "シ", "ス", "セ", "ソ")
kanatbl(15) = Array("タ", "チ", "ツ", "テ", "ト")
kanatbl(16) = Array("ウ゛ァ", "ウ゛ィ", "ウ゛", "ウ゛ェ", "ウ゛ォ")
kanatbl(17) = Array("ワ", "ヰ", "ウ", "ヱ", "ヲ")
kanatbl(18) = Array("ァ", "ィ", "ゥ", "ェ", "ォ")
kanatbl(19) = Array("ヤ", "イ", "ユ", "イェ", "ヨ")
kanatbl(20) = Array("ザ", "ジ", "ズ", "ゼ", "ゾ")
kanatbl(21) = Array("ビャ", "ビィ", "ビュ", "ビュ", "ビョ")
kanatbl(22) = Array("チャ", "チ", "チュ", "チェ", "チョ")
kanatbl(23) = Array("ヂャ", "ヂィ", "ヂュ", "ヂェ", "ヂョ")
kanatbl(24) = Array("ギャ", "ギィ", "ギュ", "ギェ", "ギョ")
kanatbl(25) = Array("ヒャ", "ヒィ", "ヒュ", "ヒュ", "ヒョ")
kanatbl(26) = Array("ジャ", "ジ", "ジュ", "ジェ", "ジョ")
kanatbl(27) = Array("キャ", "キィ", "キュ", "キェ", "キョ")
kanatbl(28) = Array("ャ", "ィ", "ュ", "ェ", "ョ")
kanatbl(29) = Array("ミャ", "ミィ", "ミュ", "ミェ", "ミョ")
kanatbl(30) = Array("ンア", "ンイ", "ンウ", "ンエ", "ンオ")
kanatbl(31) = Array("ニャ", "ニィ", "ニュ", "ニェ", "ニョ")
kanatbl(32) = Array("ピャ", "ピィ", "ピュ", "ピェ", "ピョ")
kanatbl(33) = Array("リャ", "リィ", "リュ", "リェ", "リョ")
kanatbl(34) = Array("シャ", "シ", "シュ", "シェ", "ショ")
kanatbl(35) = Array("シャ", "シィ", "シュ", "シェ", "ショ")
kanatbl(36) = Array("ツァ", "ツィ", "ツ", "ツェ", "ツォ")
kanatbl(37) = Array("チャ", "チィ", "チュ", "チェ", "チョ")
kanatbl(38) = Array("ャ", "ィ", "ュ", "ェ", "ョ")
kanatbl(39) = Array("ジャ", "ジィ", "ジュ", "ジェ", "ジョ")
kanatbl(40) = Array("lta", "lti", "ッ", "lte", "lto")
kanatbl(41) = Array("xta", "xti", "ッ", "xte", "xto")
roma = StrConv(roma, vbNarrow Or vbLowerCase)
retStr = "": Pre = "": i = 1: index = 1
Do While i <= Len(roma)
k = 0: j1 = 0: j2 = 0
If Mid(roma, i, 1) Like "[a-z-]" Then
On Error Resume Next
k = Application.WorksheetFunction.Match(Mid(roma, i, 1), conv0, 0)
On Error GoTo 0
If k > 0 Then
retStr = retStr & IIf(index = 1, Pre, "") & kanatbl(index)(k - 1)
Pre = "": i = i + 1: index = 1
ElseIf k = 0 Then
On Error Resume Next
j2 = Application.WorksheetFunction.Match(Mid(roma, i, 2), conv2, 0)
j1 = Application.WorksheetFunction.Match(Mid(roma, i, 1), conv1, 0)
On Error GoTo 0
If j2 > 0 Then j1 = 0
index = 1 - (j2 > 0) * 19 + j2 + j1
Select Case Pre
Case Mid(roma, i, 1)
retStr = retStr & "ッ"
Case "n", "nn"
retStr = retStr & "ン"
Case "-"
retStr = retStr & "ー"
Case Else
retStr = retStr & Pre
End Select
Pre = Mid(roma, i, IIf(j2, 2, 1))
i = i + 1 + IIf(j2, 1, 0)
End If
Else
retStr = retStr + IIf(Pre = "nn" Or Pre = "n", "ん", Pre) & Mid(roma, i, 1)
Pre = ""
index = 1
i = i + 1
End If
Loop
roma2kana = retStr & IIf(Pre = "nn" Or Pre = "n", "ん", Pre)
If Not katakana Then roma2kana = StrConv(roma2kana, vbHiragana)
End Function
（´・ω・`） 2020/09/23(水) 16:28
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.