(VBA)TextBox記入文字を分かりやすく表示

質問

UserFormにTextBoxを配置した場合、
記入した文字列がビジュアル的に明確に判るようにしたい。

例えば、３文字(スペース、ハイフォン、スペース）入力した場合は
例えば、参考画像のように
①　背景色を変える
②　罫線（格子）で囲む
等

多分、EXCEL（VBA)の標準機能では希望のような事は出来ないと思いますので
画像は、あくまで参考なので他のアイデアで判りやすくなれば方法は問いません。

記入した文字は、後で標準モジュールで値を利用したいので
表示だけを見せるは希望しません。

回答No.32

kkkkkm · ベストアンサー

> コードを追加して思っていた事が出来るようになりました。

よかったです。うまくいくかなとちょっとドキドキしてました。

一点忘れてました
Change()なので
Application.EnableEvents = False

Application.EnableEvents = True

で囲っておかないと、問題が起こる可能性がありますので以下に変更しておいてください。

Private Sub Target_Change()
Application.EnableEvents = False
With Target
If InStr(.Text, " ") Then
.BackColor = RGB(176, 196, 222)
Else
.BackColor = &H80000005
End If
End With
Application.EnableEvents = True
End Sub

クラスはエクセルでは殆ど使う事は無いと思いますが、ひな形みたいなものだと思うといいかもしれません。

お礼

追加のコードをありがとうございます。

今回は、これで失礼します。

回答No.31

kkkkkm

「UserForm_Initialではフォーカスできません。」

の理由が分かりました。

UserForm1.Show vbModeless

で開くと
Initialize()
で
.SetFocus
が効きませんでした。

なので

Initialize()
で
.SetFocus
をすべてやめて(.SetFocusがあると以下を設定してもフォーカスしません)

Private Sub UserForm_Activate()
'フォーカスする
Me.TB1.SetFocus
End Sub
にしておいた方が無難ですね。

お礼

kkkkkmさん、
　Class1でコードを簡素化して利用する方法ありがとうございます。

コードを追加して思っていた事が出来るようになりました。
（Classを追加して利用したことが全くなかったので
　ブラックボックスで利用しているだけの現状ですが....
　Classを利用するのは、正直わたしには難しそうです。）

お陰様で
　これでやりたかった事を含めてすっくりしました。

今回も長々とお付き合い願いありがとうございました。

p.s.
SetFocusの件、検証いただき感謝します。

回答No.30

kkkkkm

クラスで作成する場合、現状のテキストボックスのChangeイベント
Private Sub TB1_Change()
等は削除しておいてください。

回答No.29

kkkkkm

イベントを動的にクラスで作成
これでいけると思います。昔のコード(かなりごちゃごちゃしていた)を基にしたのでもしかしたら無駄な部分(無くてもいい部分)があるかもしれません。

Class1のコード

Option Explicit

Private WithEvents Target As MSForms.TextBox

''新しくイベントを作成
Public Sub SetCtrl(New_Ctrl As MSForms.TextBox)
Set Target = New_Ctrl
End Sub

'↓これが実際い実行されるイベント
Private Sub Target_Change()
With Target
If InStr(.Text, " ") Then
.BackColor = RGB(176, 196, 222)
Else
.BackColor = &H80000005
End If
End With
End Sub

Class1ここまで

フォームモジュールのコード

Option Explicit

Private mTextBox() As Class1

'↑これは絶対一番上に

Private Sub UserForm_Initialize()
Dim i As Long

'現在のコード

For i = 1 To 9
Call Make_Event(i)
Next

End Sub

Function Make_Event(ByVal i As Long)
ReDim Preserve mTextBox(i)
Set mTextBox(i) = New Class1
mTextBox(i).SetCtrl Me("TB" & i)
End Function

回答No.28

kkkkkm

> .FontSize = 18　でもエラーにはなりませんでした。

テストありがとうございます。安心しました。

> Private Sub UserForm_Activate()
> '最初の升目（TB1）
> TB1.SetFocus

「UserForm_Initialではフォーカスできません。」
というのがあったのですね。なんかかなり昔にSetFocusがうまくいかないという事例があったと思ったのですが、他の方の回答にたいしてあれこれ言うのも気が引けましたし、うまくいかない状態を思い出せないのと、エラーにもならないので気にしませんでした。

> 後、TB4-TB9まで同じような書式ですが
> これって簡素にできませんか　？

この要望は来ると思ってました。

クラスを使って動的にイベントを作る方法でできたと思います。
やり方を思い出すまでしばし時間をください。

回答No.27

HohoPapa

>https://daitaideit.com/vba-textbox-focus/
この記事にどれほどの信ぴょう性があるのか定かではありませんが、
少なくとも#21のコードと
後記コードの組み合わせで、私の環境ではエラーにはなりません。

常識的には、.Show　のあとで行うのがセオリーとは思います。

回答No.26

kkkkkm

あと

With Controls("TB" & i)
の中の
.SetFocus
を残したまま

For i = 1 To 9
を

For i = 9 To 1 Step -1

にしたら

TB1.SetFocus
はどこにもいらなくなります。

お礼

＞For i = 9 To 1 Step -1

なるほど、最下部から構築すれば.SetFocusは必要ないですね。
頭からで判るように.SetFocusは残しました。

＞FontSize間のドットなしでエラーになりますか　？

.FontSize = 18　でもエラーにはなりませんでした。

＞テキストボックスのプロパティのFontで文字とか下線とかの設定をしても同じですよね

はい。
プロパティでセットできるのは理解していますが
コードで指定した方が見やすいのでは無いかと思ってコードで記載しました。
（この辺は、ユーザーフォームに成れていないのが原因だと思います。）

ほぼ出来上がったのですが
やはり半角スペースの場合を背景色で特定したくて以下を追加しました。
（空白と""の区別を付けるために）

後、TB4-TB9まで同じような書式ですが
これって簡素にできませんか　？

Private Sub TB1_Change()

If InStr(Me.TB1.Text, " ") Then
Me.TB1.BackColor = RGB(176, 196, 222)
Else
Me.TB1.BackColor = &H80000005
End If
End Sub

Private Sub TB2_Change()

If InStr(Me.TB2.Text, " ") Then
Me.TB2.BackColor = RGB(176, 196, 222)
Else
Me.TB2.BackColor = &H80000005
End If
End Sub

Private Sub TB3_Change()

If InStr(Me.TB3.Text, " ") Then
Me.TB3.BackColor = RGB(176, 196, 222)
Else
Me.TB3.BackColor = &H80000005
End If
End Sub

回答No.25

kkkkkm

> Private Sub UserForm_Activate()
> '最初の升目（TB1）
> TB1.SetFocus

これをするなら

Private Sub UserForm_Initialize()
の一番最後に

Me.TB1.SetFocus

として

With Controls("TB" & i)
の中の
.SetFocus
を外せばいいと思いますよ。

あと確認させてください。

Font.Size
は
FontSize
間のドットなしでエラーになりますか
本来はエクセルのVBAでは間にドットありの
Font.Size
が正しいのですが、こちらでは
FontSize
でいけてるので気が付かないのです。アクセスのVBAだとFontSizeなのでその記憶で記載している感じです。

回答No.24

kkkkkm

> 「オブジェクトは、このプロパティまたはメソッドをサポートしていません」

> .Font.Height = 24
> .Font.Width = 24

というのは無いと思います。

あと

UserForm1.Show

Dim TTB1 As String, TTB2 As String, TTB3 As String

TTB1 = UserForm1.TB1.Text & UserForm1.TB2.Text & UserForm1.TB3.Text
TTB2 = UserForm1.TB4.Text & UserForm1.TB5.Text & UserForm1.TB6.Text
TTB3 = UserForm1.TB7.Text & UserForm1.TB8.Text & UserForm1.TB9.Text

Dim Delimiter As Variant
Delimiter = Array(TTB1, TTB2, TTB3)

の配列に入れるところも最初から入れてしまうとか(好みの問題かもしれません)

Dim Delimiter(0 To 2) As Variant
Dim j As Long, i As Long
UserForm1.Show
j = 0
With UserForm1
For i = 1 To 9 Step 3
Delimiter(j) = .Controls("TB" & i).Text & .Controls("TB" & i + 1).Text & .Controls("TB" & i + 2).Text
j = j + 1
Next
End With

お礼

ありがとうございます。

FONTの高さと幅の設定コードは無いのでエラーになるのですね。
削除しました。
（UserForm1.Height＝　があるので同じで良いかな思いましたが...
　　　何でないのだろう　？）

最初の升目に注目の意味でで以下を追加しました。

Private Sub UserForm_Activate()
'最初の升目（TB1）
TB1.SetFocus

回答No.23

kkkkkm

With UserForm1
UserForm1.TB1.Text = ""
UserForm1.TB2.Text = ""
UserForm1.TB3.Text = ""
UserForm1.TB4.Text = ""
UserForm1.TB5.Text = ""
UserForm1.TB6.Text = ""
UserForm1.TB7.Text = ""
UserForm1.TB8.Text = ""
UserForm1.TB9.Text = ""

End With

ですが、以前Showの前に書くと""にできると言ったのはHideした後でShowした場合に""したい場合の事で、HideでShowじゃないのでしたらとりあえずはいらないですよ。

あとテキストボックスの初期化はループでできます。
.FontSize = 14とか指定したたらカーソルはそのサイズになると思いますよ。

Private Sub UserForm_Initialize()
Dim i As Long

For i = 1 To 8
With Controls("TB" & i)
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.FontSize = 14
.MaxLength = 1
End With
Next
End Sub

お礼

ありがとうございます。

欲張って色々設定を記載して内にエラーが出るようになりました。

Sub test()の最初のUserForm1.Showで
「オブジェクトは、このプロパティまたはメソッドをサポートしていません」

今までエラーが出なかったのにエラーがでるようになったのは
Private Sub UserForm_Initialize()で色々追加したのが原因と思いますが....　？

Option Explicit

Private Sub CommandButton1_Click()
UserForm1.Hide
End Sub

Private Sub UserForm_Initialize()

Dim i As Long
For i = 1 To 9
With Controls("TB" & i)
.Font.Size = 18
.Font.Name = "MS ゴシック"
.Font.Height = 24
.Font.Width = 24
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
.SetFocus
End With
Next

End Sub

’--------------------------------------------------
Option Explicit
Sub test()

UserForm1.Show

Dim TTB1 As String, TTB2 As String, TTB3 As String

TTB1 = UserForm1.TB1.Text & UserForm1.TB2.Text & UserForm1.TB3.Text
TTB2 = UserForm1.TB4.Text & UserForm1.TB5.Text & UserForm1.TB6.Text
TTB3 = UserForm1.TB7.Text & UserForm1.TB8.Text & UserForm1.TB9.Text

Dim ws As Worksheet

Dim buf
Dim i As Long
Dim ln As Long
Set ws = Worksheets("DATA")

ws.Range("B:F").ClearContents

ln = ws.Cells(Rows.Count, 1).End(xlUp).Row

Dim Delimiter As Variant
Delimiter = Array(TTB1, TTB2, TTB3)

For i = 1 To ln
If ws.Cells(i, "A") <> "" Then 'ターゲットの文字列が無い場合
buf = mySplit(ws.Cells(i, 1).Value, Delimiter)
ws.Cells(i, 2).Resize(, UBound(buf) + 1).Value = buf
End If
Next

ws.Columns("A:F").AutoFit

End Sub

Sub My_Split()
Dim buf
Dim i As Long
Dim ln As Long
Dim ws As Worksheet

Set ws = Worksheets("DATA")

ws.Range("B:F").ClearContents

ln = Cells(Rows.Count, 1).End(xlUp).Row

Dim Delimiter As Variant
Delimiter = UserForm1.Delimiter

For i = 1 To ln
If Cells(i, "A") <> "" Then 'ターゲットの文字列が無い場合
buf = mySplit(Cells(i, 1).Value, Delimiter)
Cells(i, 2).Resize(, UBound(buf) + 1).Value = buf
End If
Next

ws.Columns("A:E").AutoFit

End Sub

Function mySplit(ByVal s, Delimiter As Variant) As String()
Dim tmp As Variant

If IsArray(Delimiter) Then
For Each tmp In Delimiter
s = Replace(s, tmp, vbTab)
Next
mySplit = Split(s, vbTab)
Else
mySplit = Split(s, Delimiter)
End If
End Function

回答No.22

HohoPapa

>1文字目のマスの中のカーソルが小さいのです。
focusを当てれば、大きくなると思います。

こんなコードです。

Private Sub UserForm_Initialize()
With TB1
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
.SetFocus
End With

お礼

ありがとうございます。

欲張って色々設定を記載して内にエラーが出るようになりました。

Sub test()の最初のUserForm1.Showで
「オブジェクトは、このプロパティまたはメソッドをサポートしていません」

今までエラーが出なかったのにエラーがでるようになったのは
Private Sub UserForm_Initialize()で色々追加したのが原因と思いますが....　？

Option Explicit

Private Sub CommandButton1_Click()
UserForm1.Hide
End Sub

Private Sub UserForm_Initialize()

Dim i As Long
For i = 1 To 9
With Controls("TB" & i)
.Font.Size = 18
.Font.Name = "MS ゴシック"
.Font.Height = 24
.Font.Width = 24
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
.SetFocus
End With
Next

End Sub

’--------------------------------------------------
Option Explicit
Sub test()

UserForm1.Show

Dim TTB1 As String, TTB2 As String, TTB3 As String

TTB1 = UserForm1.TB1.Text & UserForm1.TB2.Text & UserForm1.TB3.Text
TTB2 = UserForm1.TB4.Text & UserForm1.TB5.Text & UserForm1.TB6.Text
TTB3 = UserForm1.TB7.Text & UserForm1.TB8.Text & UserForm1.TB9.Text

Dim ws As Worksheet

Dim buf
Dim i As Long
Dim ln As Long
Set ws = Worksheets("DATA")

ws.Range("B:F").ClearContents

ln = ws.Cells(Rows.Count, 1).End(xlUp).Row

Dim Delimiter As Variant
Delimiter = Array(TTB1, TTB2, TTB3)

For i = 1 To ln
If ws.Cells(i, "A") <> "" Then 'ターゲットの文字列が無い場合
buf = mySplit(ws.Cells(i, 1).Value, Delimiter)
ws.Cells(i, 2).Resize(, UBound(buf) + 1).Value = buf
End If
Next

ws.Columns("A:F").AutoFit

End Sub

Sub My_Split()
Dim buf
Dim i As Long
Dim ln As Long
Dim ws As Worksheet

Set ws = Worksheets("DATA")

ws.Range("B:F").ClearContents

ln = Cells(Rows.Count, 1).End(xlUp).Row

Dim Delimiter As Variant
Delimiter = UserForm1.Delimiter

For i = 1 To ln
If Cells(i, "A") <> "" Then 'ターゲットの文字列が無い場合
buf = mySplit(Cells(i, 1).Value, Delimiter)
Cells(i, 2).Resize(, UBound(buf) + 1).Value = buf
End If
Next

ws.Columns("A:E").AutoFit

End Sub

Function mySplit(ByVal s, Delimiter As Variant) As String()
Dim tmp As Variant

If IsArray(Delimiter) Then
For Each tmp In Delimiter
s = Replace(s, tmp, vbTab)
Next
mySplit = Split(s, vbTab)
Else
mySplit = Split(s, Delimiter)
End If
End Function

補足

以下URLによると以下の説明がありました。

'UserForm_Initialではフォーカスできません。
'ユーザフォームを開いた際にフォーカスするには『UserForm_Activate』が必要になります。

https://daitaideit.com/vba-textbox-focus/

以下に変更しました。

Private Sub UserForm_Activate()
'最初の升目（TB1）
TB1.SetFocus