今回は電光掲示板もどきを作ってみます。
今回は、電光掲示板風に見えるプログラムを開設します。
約12年前に筆者がまだVBAを覚えたてのころ作ったものですから、あまりうまくできていませんが、素人の初心者でもこの程度の物は作れるようになるという代物です。
概要
ポイント
掲示板フォームを×ボタンで終了するとき、エクセルを元の位置に戻すようにしています。
メッセージデータはSheet2の特定のセル範囲に蓄積されます。
コードの説明
Labelの上をTextBoxが流れる
掲示板のフォーム全体の様子
フォーム上に配置したオブジェクト
ラベル (メッセージを走らせるロード用とオブジェクトの説明用に全部で3個)
テキストボックス (メッセージ用)
ボタン (Goとstop用に2個)
スクロールバー (メッセージが流れるスピードの調整用)
スピンボタン (スピード調整のしきい値調整用)
デザインポイント
フォームにラベルを貼り付ける。デザイン画面のLabelのプロパティーで背景色を黒にします。
その上にTextBoxを配置します。プロパティーで背景色を黒にして、ラベルと同化するようにします。ボーダーカラーも黒にしておきます。FontColorを緑に設定します。Fontはポップ調にしましたがこの辺は好みで設定してください。フォントサイズは24にしてますがこの辺もお好みで調整ください。
ポイントはTextBoxのAutoSizeをTrueにしてください(デフォルトはFalse)。文字列の長さに応じてTextBoxの幅を自動的に調整してくれます。
コードのポイント
繰り返し処理のやり方
繰り返しの処理では、繰り返す回数が決まっている場合はFor…Nextを使い、回数が決まっていない場合はDo…Loopを使います。
今回はストップをかけるまでは文字列を流し続けるのでDo…Loopを使いました。任意の時に文字の流れを止めるまでは延々と繰り返し処理、文字列が流れ続けます。(ストップ処理を入れ忘れると無限ループとなり他の処理ができなくなりますから十分注意が必要です)
下記のDoとLoopの間に入れた一文が処理を止める処理です。
コマンドボタンはクリックするたびにボタンの表面の文字列にstopとGoが交互に表示されるようにしています。
繰り返す処理の中で繰り返しの先頭に来たらコマンドボタンのキャプションをチェックしています。ユーザーがコマンドボタンをクリックしてボタンの表示がstopになったら文字の流れが止まります。
Do
If CommandButton1.Caption = “stop” Then Exit Do
・
・ 文字が流れる処理
・
Loop
待ち時間をつくる
繰り返しの処理は非常に高速です。千回でも万回でも瞬時に処理が終わりますからスピードの調整機能を入れないと、目にもとまらぬ速さで文字が流れてしまいます。あまりに早くて見た目には何も起こっていないように見えます。ここでは一番簡単な待ち時間を作る方法をとっています。(というか、これを作ったときは初心者すぎてwaitやsleepなど他の方法がわからなかったのです。それでも何とかなるものです。)
下記が待ち時間を作る処理です。
For…Nextを使って、利用しても差し支えないセルに、なんの意味もない空白文字を書き込み時間を浪費する処理です。変数maxsにはスピード調節用のスライダーのValueが入るようにしています
‘待ち時間を作る
For i = 1 To maxs
Cells(i, 1) = “”
Next i
この処理を入れることで、あまりに早く流れてしまうスピードを調節できるようになりました。
文字列を流す
以下が文字列を左方向へ移動させる処理です
Do
・
・
TextBox2.Left = TextBox2.Left – 1
・
・
Loop
DoEventsの役割
繰り返し処理の中で文字列を表示しているテキストボックス2の位置を‐1でずらしていくことで文字が流れる様子を表現していますが、コンピュータのCPUは繰り返す処理に専念していてオブジェクトのUI表示は行われません。文字列はDoに入る前の状態を表示していて、繰り返し処理が終了したときLoopを抜けたときはじめてテキストボックスの位置が更新されます。つまり文字が流れる表示ができません。そこで、DoEventsの登場です。DoEventsは処理の流れをCPUに渡す役割をします。
Javaで言うとthread(非同期処理)のようなものらしいです。
この一文を入れることでテキストボックスの移動を見た目にわかるように表現できるのです。
Do
・
・
TextBox2.Left = TextBox2.Left – 1
DoEvents ‘処理をwindowsに渡す
‘=========== ‘文字列の右端がロードの左端に達したら
‘ロードの右端に位置を変更する
If TextBox2.Left + TextBox2.Width <= 0 Then
TextBox2.Left = Me.Width
End I
・
・
Loop
DoEvents 以下の処理では、テキストボックスが移動を続けてフォームの左端を過ぎたら、右端に位置を戻すようにテキストボックスの位置をチェックしています。
この処理のおかげで、文字列が左端から消えたら続けて右端から現れるという電光掲示板らしき様子が表現できたと思います。
テキストボックスのプロパティーで文字列の長さで自動的にテキストボックスのwigth(横幅)を調節するよう指定しておきます
エクセル本体を消す
Application.Left = -Application.Width
Applicationというのはエクセル本体の事です。エクセルのLeft値に現在の表示幅の値をマイナスで与えるとディスプレーの左側端から追い出すことが出来ます。エクセルは消えたわけではなく画面の左側外に開いたままになっています。(消えたように見えるだけです。)
エクセルを追い出す前に元の位置を覚えておいてフォームが閉じたときこの位置をエクセルに与えれば追い出したエクセルは元の位置に戻ります。
エクセルが画面から追い出された状態のまま、エクセルの他のファイルを開いても見た目には何も変わりません。(画面から追い出されていると他のエクセルファイルは起動できない様です)
練習用エクセルファイルのダウンロードは下記から
プログラム全部
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 |
Dim mytop As Integer Dim myleft As Integer Private Sub CommandButton1_Click() If ComboBox1.Text = "" Then MsgBox "表示する文字列が選択されていません・・又は、文字列を書き込んで下さい。" Exit Sub End If 'テキスト2はボックスの長さをAutoSize=Trueにセットしています。 Dim i As Long, maxs As Long, moji As String If kensa(ComboBox1.Text) = False Then '表示するテキストが書き込みしてなければ新しく追加書き込みする maxs = ActiveSheet.Rows.Count Cells(maxs, 5).End(xlUp).Offset(1) = ComboBox1.Text End If 'コンボボックスに テキスト内容データの範囲をセットする ComboBox1.RowSource = "e1:e" & Range("e1").CurrentRegion.Rows.Count Me.Height = 115 TextBox2.Text = ComboBox1.Text ComboBox1.Visible = False CommandButton1.Visible = False CommandButton2.Visible = True CommandButton2.SetFocus '表示テキストの移動スピードをセットする maxs = ScrollBar1.Value '電光掲示板の処理本体============================ Do If CommandButton1.Caption = "stop" Then Exit Do '待ち時間を作る For i = 1 To maxs Cells(i, 1) = "" Next i '文字列を左方向へ移動させる TextBox2.Left = TextBox2.Left - 1 '=========== DoEvents '処理をwindowsに渡す '=========== '文字列の右端がロードの左端に達したら 'ロードの右端に位置を変更する If TextBox2.Left + TextBox2.Width <= 0 Then TextBox2.Left = Me.Width End If Loop '================================================== CommandButton1.Caption = "GO" CommandButton1.Visible = True CommandButton2.Visible = False 'TextBox1.Text = "" End Sub Private Sub CommandButton2_Click() '電光掲示テキストの移動処理をストップする CommandButton1.Caption = "stop" '======================================= TextBox2.Text = "" ComboBox1.Visible = True TextBox2.Left = Me.Width ComboBox1.SetFocus Me.Height = 158 End Sub Private Sub ScrollBar1_Change() 'テキストの移動速度調節後値を保存する TextBox3 = ScrollBar1.Value End Sub Private Sub SpinButton1_SpinDown() If ScrollBar1.Max >= 10 Then ScrollBar1.Max = ScrollBar1.Max - 10 End If TextBox4.Value = ScrollBar1.Max End Sub Private Sub SpinButton1_SpinUp() If ScrollBar1.Max <= 990 Then ScrollBar1.Max = ScrollBar1.Max + 10 End If TextBox4.Value = ScrollBar1.Max End Sub Private Sub UserForm_Activate() On Error GoTo era1 '前回までのテキスト移動速度をセット=== SpinButton1.Value = Range("b1").Value ScrollBar1.Max = Range("b1").Value TextBox4 = Range("b1").Value ScrollBar1.Value = Range("c1").Value '==================================== ComboBox1.SetFocus 'コンボボックスの表示範囲をセットする ComboBox1.RowSource = "e1:e" & Range("e1").CurrentRegion.Rows.Count Exit Sub era1: MsgBox "エラー発生" excelmodori Unload UserForm1 End Sub Private Sub UserForm_Initialize() '元々のエクセルの表示位置を保存する(変数宣言はジェネラルに) mytop = Application.Top myleft = Application.Left 'エクセル本体を非表示にする Application.WindowState = xlNormal Application.Left = -Application.Width End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 'テキスト移動処理をとめる CommandButton1.Caption = "stop" 'エクセルを元の位置に戻して表示する excelmodori End Sub Private Sub excelmodori() 'エクセルを元の位置に戻して表示する Application.Top = mytop Application.Left = myleft ActiveWorkbook.Save End Sub Public Function kensa(moji As String) As Boolean Dim r As Integer '同じ文字列(表示テキスト)があればTRUEを返し無ければFALSEを返す r = 0 Do r = r + 1 If Cells(r, 5) = "" Then Exit Do If Cells(r, 5) = moji Then kensa = True Exit Do Else kensa = False End If Loop End Function |
1 2 3 4 |
Private Sub Workbook_Open() Sheet1.Activate UserForm1.Show End Sub |
コメント
[…] 詳細はこちらからどうぞ。 […]