(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.21

HohoPapa

承知かもしれませんが、fontには
文字ごとの幅が同じ
等幅フォント 【monospaced font】 固定幅フォント
と
文字ごとに幅の異なる
TrueType 【TT】 TrueTypeフォント / TrueType font
があります。
後者の場合は、おそらく事実上、今回のideaは使えません。

前者のＭＳ ゴシックでフォントサイズを12とした場合のコードを後記します。
textボックスの場合、先頭に余白があるようです。
その補正が
　Const H = 8　　です。

今更ですが、私だったら、
文字列を埋めるtextボックス※１を１つと、
利用者に画面上で見せるtextボックス※２を３つ用意し
入力時には※１を表示し
入力後には※１を非表示にし、※２を表示させるような制御を行います。

Sub Sample1()
　'UserForm1のコントロールを初期設定

　Const w = 12
　Const H = 8
　Const t = "あいう"

　With UserForm1

　　.LineTate1.Width = 2
　　.LineTate2.Width = 2
　　.LineTate3.Width = 2
　　.LineTate4.Width = 2

　　.LineTate1.Top = .TextBox1.Top
　　.LineTate2.Top = .TextBox1.Top
　　.LineTate3.Top = .TextBox1.Top
　　.LineTate4.Top = .TextBox1.Top

　　.LineTate1.Height = .TextBox1.Height
　　.LineTate2.Height = .TextBox1.Height
　　.LineTate3.Height = .TextBox1.Height
　　.LineTate4.Height = .TextBox1.Height

　　.TextBox1.Text = t
　　.LineTate1.Left = .TextBox1.Left
　　.LineTate2.Left = .TextBox1.Left + (w * 1) + H
　　.LineTate3.Left = .TextBox1.Left + (w * 2) + H
　　.LineTate4.Left = .TextBox1.Left + (w * 3) + H

　　.LineTop.Height = 2
　　.LineTop.Top = .TextBox1.Top
　　.LineTop.Left = .TextBox1.Left
　　.LineTop.Width = .TextBox1.Width

　　.LineBottom.Height = 2
　　.LineBottom.Top = .TextBox1.Top + .TextBox1.Height
　　.LineBottom.Left = .TextBox1.Left
　　.LineBottom.Width = .TextBox1.Width

　　.Show
　End With

End Sub

Sub Sample2()
　'罫線を非表示
　With UserForm1
　　.LineTate1.Visible = False
　　.LineTate2.Visible = False
　　.LineTate3.Visible = False
　　.LineTate4.Visible = False
　　.LineTop.Visible = False
　　.LineBottom.Visible = False
　End With
End Sub

Sub Sample3()
　'罫線を表示
　With UserForm1
　　.LineTate1.Visible = True
　　.LineTate2.Visible = True
　　.LineTate3.Visible = True
　　.LineTate4.Visible = True
　　.LineTop.Visible = True
　　.LineBottom.Visible = True
　End With
End Sub

お礼

kkkkkmさん、HohoPapa相談が長期になりますが

>申しわけないですが何の為にこのような事をしているのかがいまだに私には不明です。

そうですね。
何でこの相談を立ち上げたかを説明します。

前提として
シートにあるA列の文字列を指定文字列で分割すると言うマクロを作成しています。

指定文字列を最初は、G列に入れていましたが
ターゲットのA列の間に分割された文字列群（B,C,D,E列）があり
「これは、見た目も良くない」と思い。

G列の代わり好みの問題でしょうが
　ユーザーフォームを表示して
　指定文字列をマス目の中で設定する用コードを編集する事にしました。

お二人のお陰様で何とか以下のコードで機能するようにはなりましたが、
ちょっと直したい点があります。

参考画像にあるように
test()を起動直後、ユーザーフォームが表示されますが
1文字目のマスの中のカーソルが小さいのです。

一度、右クリックするとカーソルは大きくなります。

最初から（右クリックしなくても）カーソルを大きくする方法はありませんか　？

又、記載したコードで気になる点（修正すべき点）あればご指導ください。

参考画像
https://imgur.com/OVoDGqF

Sub test()

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

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

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

’---------------------　以下「ユーザーフォーム」

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

With TB2
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

With TB3
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With
With TB4
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

With TB5
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

With TB6
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

With TB7
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

With TB8
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

回答No.20

kkkkkm

忘れてました。今更ながらですが
画像のテキストボックス内での左端の位置は探さなくても
Me.TextBox1.Left + 5
(左に余白がある場合)
でいける感じですので
MS Gothicの12だと最後の端に表示する場合は
Me.Image1.Left = Me.TextBox1.Left + 5 + (Len(Me.TextBox1.Text) * 6.5)
でいけるかも。
またなにかの時の参考にでもしてください。

回答No.19

kkkkkm

> 何とか先も見えたので16：37(補足)で記載したコードで
> 　次のステップに進みたいと思います。

申しわけないですが何の為にこのような事をしているのかがいまだに私には不明です。
半角スペースを見分けたいという事でもなさそうな気もしますし・・・

お礼

kkkkkmさん、HohoPapa相談が長期になりますが

>申しわけないですが何の為にこのような事をしているのかがいまだに私には不明です。

そうですね。
何でこの相談を立ち上げたかを説明します。

前提として
シートにあるA列の文字列を指定文字列で分割すると言うマクロを作成しています。

指定文字列を最初は、G列に入れていましたが
ターゲットのA列の間に分割された文字列群（B,C,D,E列）があり
「これは、見た目も良くない」と思い。

G列の代わり好みの問題でしょうが
　ユーザーフォームを表示して
　指定文字列をマス目の中で設定する用コードを編集する事にしました。

お二人のお陰様で何とか以下のコードで機能するようにはなりましたが、
ちょっと直したい点があります。

参考画像にあるように
test()を起動直後、ユーザーフォームが表示されますが
1文字目のマスの中のカーソルが小さいのです。

一度、右クリックするとカーソルは大きくなります。

最初から（右クリックしなくても）カーソルを大きくする方法はありませんか　？

又、記載したコードで気になる点（修正すべき点）あればご指導ください。

参考画像
https://imgur.com/OVoDGqF

Sub test()

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

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

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

’---------------------　以下「ユーザーフォーム」

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

With TB2
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

With TB3
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With
With TB4
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

With TB5
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

With TB6
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

With TB7
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

With TB8
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

回答No.18

kkkkkm

> ３つのTerxtBoxを並べて１つのTextBoxには１文字しか入力できないようにして
> 最後に３つの文字列を合成する。

3つのTerxtBoxは一番最初に思いました。一文字しかというのは考えませんでしたが、テキストボックスに一気にデータを貼り付けとかできないから一個なんだろうなぁと思って廃案にしてました。(「たとえば3文字」だったので文字数については3文字限定とは思いませんでしたし)
3文字限定なら質問のような(1)か(2)の3文字限定のテキストボックスを作ればいいような気もしますが。

また3個作るにしても真ん中が「-」限定ならそのテキストボックスを作る必要はないと思います。

こちらはフォームを閉じると内容は表示されないと思います。
フォームのボタンでMe.Hideにするか、そのクリックイベントに記載するかだと思います。

Dim TTB As String
TTB = UserForm1.TB1.Text & UserForm1.TB2.Text & UserForm1.TB3.Text
MsgBox TTB

お礼

私の方針が思い付きであやふやな所から始まっているので
解決策を摸索して形になりまで試行錯誤してしまいました。

kkkkkmさんには、回りくどい案件に長々と
　お付き合い願い感謝いたします。

何とか先も見えたので16：37(補足)で記載したコードで
　次のステップに進みたいと思います。

回答No.17

kkkkkm

あと、関係ないと思いますが
UserForm_Initializeで設定せずに
テキストボックスのプロパティのFontで文字とか下線とかの設定をしても同じですよね。

回答No.16

kkkkkm

> 以前として私のEXCELではNo.14の参考画像のように空白スペースだとフォントに下線が付きません。

セルだとどうなるのでしょうか。セルでも最後に下線が引けないとすると仕様なのかもしれませんね。
Wordだと詳細設定の下の方に「行末のスペースには下線を引く」というチェックがあるのですが、エクセルではないみたいですし・・・。

回答No.13の時のような画像を一個だけ作って(高さと位置はテキストボックスの横にして幅は自由)

If Right(Me.TextBox1.Text, 1) = " " Then
Me.Image1.Visible = True
Me.Image1.Left = 45 + (Len(Me.TextBox1.Text) * 6.6)
Me.Image1.Width = 6
Else
Me.Image1.Visible = False
End If

としておけば最後に半角スペースがあればその画像が最後のスペースの所に表示されます

とりあえずMS Gothicの12の設定で
45は最初の文字の位置(最初にスペースを入れて調整)
6.6が一文字分の移動距離(スペースを連続で入れて調整)
6は画像の幅

補足

>セルだとどうなるのでしょうか。

私のPCでは
シート上のセルの書式で下線をクリックして試すと
最後が空白のスペースでは下線が出ないので仕様のようです。
（空白のスペースが最後の場合でも
　　リーターンで確定するとスペースにも下線が付きます。）

色々と回答をいただき気が付いた点があります。

そもそも１つのTextBoxを三等分したような使い方に無理があるのではと....

３つのTerxtBoxを並べて１つのTextBoxには１文字しか入力できないようにして
最後に３つの文字列を合成する。

これなら、最初の質問の添付図の②のような見た目なるので希望の処理では無いかと...

以下考察中のコードです。

他に考慮すべき点あればアドバイスお願いします。

Sub test()

UserForm1.TB1.Text = ""
UserForm1.TB2.Text = ""
UserForm1.TB3.Text = ""

UserForm1.Show

Dim TTB As String
TTB = UserForm1.TB1.Text & UserForm1.TB2.Text & UserForm1.TB3.Text
MsgBox TTB

End Sub

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

With TB2
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

With TB3
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 255)
.MaxLength = 1
End With

End Sub

回答No.15

kkkkkm

Font.Bold = True
Font.Size = 42
Font.Name = "MS Gothic"

Fontの前にドットが抜けてます。
回答No.13のお礼の時にも抜けていたのですが、コピペした時のミスだと思って指摘しませんでした。

UserForm1.Hideは隠すだけなのでフォーム自体は閉じていません。
Initializeはフォームが開く直前に実行されますから、Hideで隠れているだけのフォームをShowしても実行されません。

(フォームモジュールでそのフォーム自身を指す場合はMeにしていたほうがフォームの名前を変更してもコードを変更しなくていいので楽だと思います)

Private Sub CommandButton1_Click()
Unload Me
End Sub

としてフォームを終了するか

他の何かは保持していたいなどでUnload Meできない場合はShowの前にテキストボックスの内容をクリアしてください。

UserForm1.TextBox1.Text = ""
UserForm1.Show

お礼

すいません。

指摘されて気が付きました。

ケアレスミスで
withなのでドットが抜けていました。

Private Sub UserForm_Initialize()

'Me.TextBox1.Text = ""　
With Me.TextBox1
.Font.Bold = True
.Font.Size = 18
.Font.Name = "MS Gothic"
.FontUnderline = True 'テキストに下線を付ける
End With

End Sub

UserForm1.TextBox1.Text = "" も
Initialize()の最初に記載しても無意味でした。
Showの前に書く事理解できました。

でも個人的にはInitialize()の最初に記載しても良さそうですが
ダメなのは、仕様ですね。

以前として私のEXCELではNo.14の参考画像のように空白スペースだとフォントに下線が付きません。

回答No.14

kkkkkm

"MS UI Gothic"はプロポーショナルフォントなので「(」と" "が狭くて判別が難しい感じです。
"MS Gothic"の方がまだわかりやすいのではないでしょうか。
「半角スペース(半角スペース]と入れてます。

> Imageを利用する方法は、試行錯誤しましたが
> おっしゃるように位置合わせが面倒で頓挫しました。

これ説明が抜けてましたフォントはMS Gothicの等幅フォントでやってます。

お礼

kkkkkmさん、ありがとうございます。

MS Gothicに変えてみましたが、No.14の参考画像のように
フォントに下線が付きません。

又、TextBoxに文字がある状態でコマンドボタンで
UserFormをHideにして
UserForm.showでマクロを再開すると以前の文字が残った状態なので
Me.TextBox1.Text = ""　を追加で入れてみましたが効果がありません。

マクロを再開したら以前の文字を削除する方法はありませんか　？

Private Sub UserForm_Initialize()

Me.TextBox1.Text = ""

With Me.TextBox1
Font.Bold = True
Font.Size = 42
Font.Name = "MS Gothic"
.FontUnderline = True 'テキストに下線を付ける
End With

End Sub

補足

マクロを再開したら以前の文字を削除するのは、
下記で出来ました。

HideでなくUnloadで一度削除が必要なようです。

Private Sub CommandButton1_Click()
Unload UserForm1
End Sub

回答No.13

kkkkkm

こちらの方が半角スペースに色がついてる感じがするかも
色々遊ばせてもらってます(笑)

お礼

kkkkkmさん、何度もありがとうございます。

アドバイスをいただき
　半角スペースがあったらバックを着色する
　フォントに下線を付ける
を採用しました。

Imageを利用する方法は、試行錯誤しましたが
おっしゃるように位置合わせが面倒で頓挫しました。

現在、下記コードをたたき台に上げていますが、
1点、気になる点があります。

TextBoxに最後に半角スペースを入れるとすると
最後の半角スペース部分に下線が付きません。

（半角スペース以外を入れるとちゃんと下線が付く）

最後が半角スペースでも下線が付くようになりませんか　？

参考画像（見えにくいかも知れませんが、赤囲いに下線は付いていません。）
https://imgur.com/WpPiaXW

標準モジュール

Option Explicit

Sub test()

UserForm1.Show

End Sub

’-----------------------------
ユーザーフォーム

Private Sub CommandButton1_Click()
UserForm1.Hide
End Sub

Private Sub UserForm_Initialize()
With Me.TextBox1
Font.Bold = True
Font.Size = 12
Font.Name = "MS UI Gothic"
.FontUnderline = True 'テキストに下線を付ける
End With

End Sub

Private Sub TextBox1_Change()

'TextBox中の文字列に半角スペースがある場合
If InStr(Me.TextBox1.Text, " ") Then
Me.TextBox1.BackColor = vbGrayText
Else
Me.TextBox1.BackColor = &H80000005 'vbWindowBackground ウィンドウの背景色
End If
End Sub

回答No.12

kkkkkm

回答No.10の太字と下線及び回答No.11を実際にやった画像