テキストボックスを自動生成するサンプル♪

テキストボックスを作って、１個に１人の名前を入れたいんだけど・・・それがまた大量にあるんだゎ

例えばこんな感じ・・・のがたくさんあるイメージ

じゃあ、自動でテキストボックスを作ってちょっと楽しよう！

名前、部品名、信号名などなど一個づつテキストボックスを作って入れたいそんな時、結構ありますよね？しかも数が多いとコピーして名前を入力するのも面倒・・・

ということで、名前などを列挙したテキストから自動でテキストボックスを生成。元となるテキストを行ごとに分けて、テキストボックスに入力してくれる簡単なプログラムご紹介します。

まずユーザーフォームを生成
ユーザーフォームにコードを入力
Sample Code
結果

まずユーザーフォームを生成

ユーザーフォームってなんだ？

ユーザーフォームは自由に作れる入力フォームみたいなもので、テキストボックスとかコマンドボタンとかを好きなように配置することができます。

今回はユーザーフォームを使って、テキストボックスに文字を入れてOKボタンを押すとテキストボックスを生成するようにします。

ユーザーフォームを表示させる

VBAエディタの挿入タブからユーザーフォームを選択します。

コマンドメニューを配置

①ユーザーフォームが表示されたら
②テキストボックスを配置
③コマンドボタンでOKとCANCELを配置
コマンドボタンの上でクリックするとボタンの上の文字が変えられます。

また詳細は説明しませんが、プロパティでオブジェクト名、背景色等々変更可能です。

ユーザーフォームにコードを入力

ユーザーフォームができたら、そこにテキストボックスを作るコードを書いていきましょう！

①図中の赤で丸を付けたところ（ユーザーフォーム名）もしくは、先ほど作ったユーザーフォームの本体をWクリックするとエディタが開きます。

②そこにコードを書いていきます。

Sample Code

内容としてはOKボタンをクリックした時に、テキストボックスのデータをSplitで分けて処理するというものになります。

コード

面倒な方はベタっと全部貼ってください。
そして、結果のところまですっとばして下さい。

Dim arrText() As Variant
Dim OffsetX, OffsetY
Dim Text_Top, Text_Bottom, Text_Left, Text_Right
Dim Text_Width, Text_Height, Text_Spacing
Dim Text_Align, Text_Font, Text_Size

Private Sub UserForm_Initialize()

'初期値設定
  OffsetX = 2.5 '最初のテキストの位置
  OffsetY = 8.7 '左側の位置
  Text_Width = 1 'テキストボックスの幅
  Text_Height = 0.3 'テキストボックスの高さ
  Text_Spacing = 0.5 'テキストボックスの間隔
  Text_Align = 1 '0:左　1:中央　2:右
  Text_Font = 0 'フォントID
  Text_Size = 11 'フォントサイズ
  

End Sub

Private Sub CommandButton2_Click()
  'キャンセルボタン
  TextBox_Intext.Text = ""
  UserForm1.hide

End Sub


Private Sub CommandButton1_Click()
  
  If (TextBox_Intext.Text <> "") Then
    'テキストボックスのデータを配列に取り込む
    arrText = Split(TextBox_Intext.Text, vbCrLf)
    I_max = UBound(arrText)
        

    For i = 0 To I_max Step 1
     
      'テキストボックスの生成
    
      'データがなければラベルは作らず、スペースを空ける
      If (arrText(i) <> "") Then
      
        'テキストボックスの位置
        Text_Top = OffsetY - (i * Text_Spacing)
        Text_Bottom = Text_Top - Text_Height
        Text_Left = OffsetX
        Text_Right = OffsetX + Text_Width
      
        Set DrawShape = Application.ActiveWindow.Page.DrawRectangle(Text_Left, Text_Top, Text_Right, Text_Bottom)
      
        With DrawShape
          .Name = "TextBox" & i
          .Cells("LinePattern") = 0
        
          With .Characters
            .Text = arrText(i)
            .ParaProps(visHorzAlign) = Text_Align
            .CharProps(visCharacterFont) = Text_Font
            .CharProps(visCharacterSize) = Text_Size
            End With
          End With
      
      End If
    
  
    Next

  End If
  
  TextBox_Intext.Text = ""
  UserForm1.hide

End Sub

初期設定のところ

Private Sub UserForm_Initialize()　のモジュールで初期設定しています。
ここでテキストボックスの位置やテキストの書式が変更できるので、設定して下さい。
因みにサイズは全部インチです。

OffsetX = 2.5 ‘最初のテキストの位置
OffsetY = 8.7 ‘左側の位置

テキストボックスは上から順に配置していきますが、その時の一番上のテキストボックスの位置をOffsetで指定しています。お好きな位置に変更して下さい。

Text_Width = 1 ‘テキストボックスの幅
Text_Height = 0.3 ‘テキストボックスの高さ
Text_Spacing = 0.5 ‘テキストボックスの間隔

この辺はテキストボックスのサイズ設定。
Text_Spacingは上のテキストボックスから次のテキストボックスまでの間隔を設定します。
詰めて配置したければ数字を小さくしてくださいね。

Text_Align = 1 ‘0:左　1:中央　2:右
Text_Font = 0 ‘フォントID
Text_Size = 11 ‘フォントサイズ

中に入るテキストの書式設定。
Text_Alignは文字位置です。
Text_Font =0だと「ＭＳＰゴシック」です。
フォントIDについてはこちら↓↓↓のサイトも参照ください。

キャンセルボタン

キャンセルボタンのオブジェクト名がCommandButton2です。

TextBox_Intext.Text = “”
UserForm1.hide

テキストボックスを空にして、ユーザーフォームを非表示にします。

OKボタン

ザックリ説明します。

‘テキストボックスのデータを配列に取り込む
arrText = Split(TextBox_Intext.Text, vbCrLf)
I_max = UBound(arrText)

Split(文字列,区切り文字)は、文字列を区切り文字で分割してarrTextという配列に代入します。
UBound(arrText)は配列の最大値を返す関数です。

なので
arrText(0)=佐藤,arrText(1)=鈴木,arrText(2)=高橋・・・・arrText(I_max)=清水みたいな感じになっています。

For i = 0 To I_max Step 1

‘テキストボックスの生成

‘データがなければラベルは作らず、スペースを空ける
If (arrText(i) <> “”) Then

‘テキストボックスの位置
Text_Top = OffsetY – (i * Text_Spacing)
Text_Bottom = Text_Top – Text_Height
Text_Left = OffsetX
Text_Right = OffsetX + Text_Width

Set DrawShape = Application.ActiveWindow.Page.DrawRectangle(Text_Left, Text_Top, Text_Right, Text_Bottom)

Visioの座標は左下が（0,0）なのでそれを踏まえて、テキストボックスの位置を指定。
DrawRectangleで矩形の図形を描いています。

With DrawShape
.Name = “TextBox” & i
.Cells(“LinePattern”) = 0

With .Characters
.Text = arrText(i)
.ParaProps(visHorzAlign) = Text_Align
.CharProps(visCharacterFont) = Text_Font
.CharProps(visCharacterSize) = Text_Size
End With
End With

ここは書式設定パートです。
ここで指定したテキストボックスができるので、お好みで変更して下さい。
.Name ：オブジェクト名
.Cells(“LinePattern”) ：テキストボックスの枠線（0だからなし）
.Text = 入力する文字列
.ParaProps(visHorzAlign) = 文字位置
.CharProps(visCharacterFont) = フォント
.CharProps(visCharacterSize) = フォントサイズ

TextBox_Intext.Text = “”
UserForm1.hide

テキストボックスを空にして、ユーザーフォームを非表示にします。