はじめに
part5と同様にレフエディット(RefEdit)は、その他のコントロールに入っている。この機能は、ユーザーフォームを表示させながらマウスでセル範囲を取得して処理を実行するものである。
プログレスバーは、処理の進捗状況を示すバーのことで、この機能はラベルを用いて実装することができる。
どちらもマルチページに登録した。
レフエディット(RefEdit)
これをドラック&ドロップをしてユーザーフォームに配置する。コマンドボタンも配置して、ここに処理を記述することになる。
RefEditの使い方は右側の長方形をクリックすると、マウスでセル範囲を指定することができ、範囲を指定し終わったら、また右端の長方形をクリックする。
後はコマンドボタンを押すと、指定された範囲に処理(この場合はランダムな色)が実行される。
コマンドボタンのコード
Private Sub CommandButton1_Click()
Dim rng As Range
Randomize
For Each rng In Range(RefEdit1.Value)
rng.Interior.ColorIndex = Int(56 * Rnd + 1)
Next rng
MsgBox "処理が終了しました"
Range(RefEdit1.Value).Clear
ActiveWorkbook.Save
End Sub
ここで注意すべき点は、変数rngである。Rangeとして宣言しているので通常はSetステートメントをつけなければならないのだが、For Each で回す場合はSetステートメントは不要である。
また、Range(RefEdit1.Value)で選択範囲をRangeに入れて処理を実行している。
Randomize、Int(56 * Rnd + 1)はともに乱数を用いて色を決める処理である。
Randomizeは引数を省略しているので現在のシステムタイマーから取得した時刻を元に乱数を初期化している。
Rnd関数は、あらかじめ定められた乱数テーブル(Randomize)にしたがって乱数を返す。
Windowsが既定で持っている色が全部で56色あるので、56と指定している。
Rnd関数は0以上1未満の値をとるので、Intを用いて小数点以下を切り捨てている。
コード自体に難しいところはないと思う。
単純にいえば、マウスで指定した範囲をRangeに入れて回し、ランダムに色を変化させてセルに代入し、最後にセル範囲を削除しているだけである。
プログレスバー
使う部品はラベルを3つとコマンドボタン1つである。
ラベルはlabel1、label3、label4(label2は削除したため欠番となっている)であり、バーの部分はlabel3で行っている。
label3のコード
コードはコマンドボタンに割り付けてある。中心となるlabel3のコードは以下の通り。
Private Sub CommandButton2_Click()
Dim stp As Single
Dim i As Integer, j As Integer
With Label3
stp = .Width / 1000 ’1000行分回すので、stpは1000で割ってある。
.Width = 0 ’幅を0に設定
.BackColor = &HFF0000 ’label3の色を青に設定。
Label1.Caption = "現在、処理を実行中です" ’label1のCaptionの表示
Randomize ’乱数の初期化。システムタイマーを使用
For i = 1 To 1000 ’1000行分回す
For j = 1 To 256 ’256列分回す
With ActiveSheet.Cells(i + 1, j) ’セルの2行目から書き出す
.Interior.ColorIndex = Int(56 * Rnd + 1) ’乱数で56色を設定
End With
Next j
.Width = .Width + stp ’幅をstp分増やしている
Label4.Caption = Int(i / 10) & "%" ’label4で増分を%として表示
DoEvents ’処理が長い場合、システムに制御を戻すためにこの命令を入れる
Next i
End With
MsgBox "色を削除します" ’メッセージボックスを表示して削除処理に移る
With Label3
stp = .Width / 1000
.Width = 0
.BackColor = &HFF0000
Label1.Caption = "削除中……"
For i = 1000 To 0 Step -1 ’行で削除するので、1000回まわすだけでよい
Range(Cells(i + 2, 1), Cells(i + 2, 256)).Clear ’1行クリア
.Width = .Width + stp
Label4.Caption = Int((1000 - i) / 10) & "%"
DoEvents
Next i
End With
Label1.Caption = "処理が終了しました"
ActiveWorkbook.Save ’最後にワークブックを上書き保存して終了
End Sub
増分の計算で、色を塗るときと削除するときに違いがある。
塗るとき With ActiveSheet.Cells(i + 1, j) Label4.Caption = Int(i / 10) & "%"
削除する Cells(i + 2, 1).EntireRow.Delete Label4.Caption = Int((1000 - i) / 10) & "%"
0から100%を表示させるため、塗るときはi+1行目(スタートは2行目)から1001行目まで記述している。
削除するときは、i+2行目(スタートは1002行目)から2行目までとしている。以前にも書いたが、削除するときは最下行から削除するので、注意しなければならない。
コードの全容
標準モジュール
Option Explicit
Option Base 1
ーーーーーーーーーーーーーーーーーーーーーーー
Public Sub actionButton()
UserForm1.Show
End Sub
ユーザーフォーム
Option Explicit
Option Base 1
ーーーーーーーーーーーーーーーーーーーーーーー
Private Sub UserForm_Initialize()
Label3.BackColor = &H8000000F
UserForm1.MultiPage1.Value = 0
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Private Sub CommandButton1_Click()
Dim rng As Range
Randomize
For Each rng In Range(RefEdit1.Value)
rng.Interior.ColorIndex = Int(56 * Rnd + 1)
Next rng
MsgBox "処理が終了しました"
Range(RefEdit1.Value).EntireRow.Delete
ActiveWorkbook.Save
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Private Sub CommandButton2_Click()
Dim stp As Single
Dim i As Integer, j As Integer
With Label3
stp = .Width / 1000
.Width = 0
.BackColor = &HFF0000
Label1.Caption = "現在、処理を実行中です"
Randomize
For i = 1 To 1000
For j = 1 To 256
With ActiveSheet.Cells(i + 1, j)
.Interior.ColorIndex = Int(56 * Rnd + 1)
End With
Next j
.Width = .Width + stp
Label4.Caption = Int(i / 10) & "%"
DoEvents
Next i
End With
MsgBox "色を削除します"
With Label3
stp = .Width / 1000
.Width = 0
.BackColor = &HFF0000
Label1.Caption = "削除中……"
For i = 1000 To 0 Step -1
Cells(i + 2, 1).EntireRow.Delete
.Width = .Width + stp
Label4.Caption = Int((1000 - i) / 10) & "%"
DoEvents
Next i
End With
Label1.Caption = "処理が終了しました"
ActiveWorkbook.Save
End Sub
サイトご利用方法
次のページ・前のページを利用するよりも、グローバルメニュー(ヘッダー部分にある項目)・サブメニュー記事の項目をクリックしていただければ、その項目の全体像が一目でみることができ、クリックすればそのサイトへ飛びます。
google、yahoo、Bingなどで検索する場合、検索ワードは先頭に、孤立じじい、と入力しその後に、グローバルメニュー・サブメニュー記事のどれかひとつの項目を入力すると、その検索サイトが上位表示されます。