今回は電光掲示板もどきを作ってみます。
今回は、電光掲示板風に見えるプログラムを開設します。
約12年前に筆者がまだVBAを覚えたてのころ作ったものですから、あまりうまくできていませんが、素人の初心者でもこの程度の物は作れるようになるという代物です。
概要
ポイント
掲示板フォームを×ボタンで終了するとき、エクセルを元の位置に戻すようにしています。
メッセージデータはSheet2の特定のセル範囲に蓄積されます。
コードの説明
Labelの上をTextBoxが流れる
掲示板のフォーム全体の様子
フォーム上に配置したオブジェクト
ラベル (メッセージを走らせるロード用とオブジェクトの説明用に全部で3個)
テキストボックス (メッセージ用)
ボタン (Goとstop用に2個)
スクロールバー (メッセージが流れるスピードの調整用)
スピンボタン (スピード調整のしきい値調整用)
デザインポイント
フォームにラベルを貼り付ける。デザイン画面のLabelのプロパティーで背景色を黒にします。
その上にTextBoxを配置します。プロパティーで背景色を黒にして、ラベルと同化するようにします。ボーダーカラーも黒にしておきます。FontColorを緑に設定します。Fontはポップ調にしましたがこの辺は好みで設定してください。フォントサイズは24にしてますがこの辺もお好みで調整ください。
ポイントはTextBoxのAutoSizeをTrueにしてください(デフォルトはFalse)。文字列の長さに応じてTextBoxの幅を自動的に調整してくれます。
コードのポイント
エクセル本体を消す
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 |
コメント