- 公開後、手順の一部に不具合があることがわかりました。現在手直し中です。
- 2月19日17時45分、手直し終了しました。
- 2月26日、コマドボタン1のVBAコードを書き直しました(書き直しの内容は、こちらの記事の後半をご覧ください。)
前々回からさらに改良したエクセル時計の作り方です。VBAをよく知らない方でも作れるように書いたつもりです。
記事は長いですが、作業時間は大したことありませんので、興味のある方はお試しください。
最初におことわりです。
- MAC版では動作しないかもしれません。
- パソコンのスペックによっては、動作しない、又は動作が安定しないかもしれません。
- 以下の手順は、エクセル2007以降の場合です。
- 以下の手順は、エクセルのバージョンによって、メニューの名称などが異なる場合があります。
- 時計は、指定した倍率で速く動きますが、実際の速度は、指定より遅くなります。パソコンのスペックにも影響されますので、倍率の指定は「目安」とお考え下さい。
まずは、動作の説明です。
エクセル時計は、Sheet1とSheet2から構成されるブックです。
Sheet2に、動作に必要な情報を入力します。
動画は、この条件で動作する様子です。
- 左側のボタンを押すと動き出します。
- 最初は倍率1の速度で動き、真ん中のボタンを押すとメッセージが現れます。OKを押すと、倍率2の速度に切り替わります。
- 速度の切り替えは何度でもできます。
- だからと言って、速度を切り替える必要はありません。
- 終了時刻になれば、自動的に動作が止まりますが、途中で終了する時は、右側のボタンを押し、現れたメッセージに従って、終わり方を選びます。
それでは作っていきましょう。
VBAが使える”マクロ有効ブック”を作る。
手順1:新しいエクセルを開く。
手順2:左上の「ファイル」タブをクリックし、
オプション → リボンのユーザー設定 に移動する。
(オプション の前に その他 があったり、リボンのカスタマイズ など
メニュー名が異なる場合があります。)
手順3: メイン タブ の下の [開発] チェック ボックスをオンにします。
手順4:開発タブが出来たことを確認しましょう。
手順5:左上の「ファイル」タブをクリックし、
名前を付けて保存 に進みます。
適当な名前を付けて、ファイルの種類で
マクロ有効ブック を選んで保存します。
新しく作ったエクセルファイルを開き、Sheet1とSheet2を加工する。
Onedriveからコピーできるようにしたかったのですが、完全な読み取り専用にすることが難しくて断念しました。画像を参考にSheet1とSheet2を加工してください。
※ シート名は必ず、Sheet1,Sheet2にしてください。
手順1:新しく作ったエクセルファイルを開きます。
手順2:Sheet1の加工
Sheet1が時計の画面になります。B2セルが時、D2セルが分、F2セルが秒を表示します。参考までに、私の時計のフォントや大きさを書いておきます。
B2、C2、D2、E2、F2セルは、フォントが HGP創英角ゴシックUB で、大きさは 150ポイントです。
B2、D2、F2セルの書式設定は、ユーザー定義 を選んで、種類欄に 00 と直接入力しました。
手順3:Sheet2を追加します。
手順4:Sheet2の加工
Sheet2は、動作に必要な情報を入力するシートです。
入力するセルの位置は、画像のとおりにしてください。
必ずではありませんが、刻み間隔を入力するセル(I4、I6)は、入力規則で、整数を指定しておくと良いと思います。
速度を切り替えが必要のない方も多いと思いますが、倍率2と刻み間隔2は、入力しないと動きません。適当な数字を入れるようにしてください。
Sheet1に、3つのコマンドボタンを作る。
VBAエディタを開いて、VBAコードを貼り付ける。
注意! ここから先の作業は、デザインモードで行います。Sheet1がデザインモードになっていることを確認してください。
手順1:コマンドボタン1とVBAコードの関連付け
コマンドボタン1にカーソルを合わせ、
右クリック → コードの表示 に進みます。
下のような画面が開きます。
Dim min As Integer
Dim endhou As Integer
Dim endmin As Integer
Dim sec As Integer
Dim kizamisec1 As Integer
Dim kizamisec2 As Integer
Dim count1 As Integer
Dim count2 As Integer
Dim count3 As Integer
Dim syo As Integer
Dim amari As Double
Dim wait1 As Double
Dim wait2 As Double
Dim wait_sec As Double
Dim b2sign As Variant
Dim owari As Integer
Dim bhenkou As Integer
Set s1 = Worksheets("sheet1").Cells
Set s2 = Worksheets("sheet2").Cells
If henkou = 3 Then
MsgBox "不正なボタン操作です。動作を続けます。"
Exit Sub
End If
henkou = 3
If s2(2, 2) = "" Then
MsgBox "開始時刻が入力されていません。"
henkou = 4
Exit Sub
End If
If s2(2, 4) = "" Then
MsgBox "開始時刻が入力されていません。"
henkou = 4
Exit Sub
End If
If s2(2, 7) = "" Then
MsgBox "終了時刻が入力されていません。"
henkou = 4
Exit Sub
End If
If s2(2, 9) = "" Then
MsgBox "終了時刻が入力されていません。"
henkou = 4
Exit Sub
End If
If s2(4, 4) = "" Or s2(4, 4) = 0 Then
MsgBox "倍率1が正しく入力されていません。"
henkou = 4
Exit Sub
End If
If s2(6, 4) = "" Or s2(6, 4) = 0 Then
MsgBox "倍率2が正しく入力されていません。"
henkou = 4
Exit Sub
End If
If s2(4, 9) = "" Or s2(4, 9) = 0 Then
MsgBox "刻み間隔1が正しく入力されていません。"
henkou = 4
Exit Sub
End If
If s2(6, 9) = "" Or s2(6, 9) = 0 Then
MsgBox "刻み間隔2が正しく入力されていません。"
henkou = 4
Exit Sub
End If
amari = 60 Mod s2(4, 9)
If amari <> 0 Then
MsgBox "刻み間隔1には、60の約数を入力してください。"
henkou = 4
Exit Sub
End If
amari = 60 Mod s2(6, 9)
If amari <> 0 Then
MsgBox "刻み間隔2には、60の約数を入力してください。"
henkou = 4
Exit Sub
End If
s2(4, 11).FormulaR1C1 = "=ROUND(RC[-2]/RC[-7],3)"
s2(6, 11).FormulaR1C1 = "=ROUND(RC[-2]/RC[-7],3)"
b2sign = ""
hou = s2(2, 2)
min = s2(2, 4)
sec = 0
endhou = s2(2, 7)
endmin = s2(2, 9)
kizamisec1 = s2(4, 9)
kizamisec2 = s2(6, 9)
s1(2, 2) = hou
s1(2, 4) = min
s1(2, 6) = sec
DoEvents
wait1 = s2(4, 11)
wait2 = s2(6, 11)
s2(4, 11).ClearContents
s2(6, 11).ClearContents
wait_sec = wait1
1 DoEvents
If henkou = 1 Then
henkou = 3
GoTo myerror
End If
If henkou = 2 Then
henkou = 3
owari = MsgBox("時計を終了します。表示している時刻を次回のスタート時刻に設定しますか? 「はい」、「いいえ」のどちらを選んでも表示は0時0分になります。 ", vbYesNoCancel)
End If
If owari = 6 Then
s2(2, 2) = s1(2, 2)
s2(2, 4) = s1(2, 4)
s1(2, 2) = 0
s1(2, 4) = 0
s1(2, 6) = 0
henkou = 4
Exit Sub
End If
If owari = 7 Then
s1(2, 2) = 0
s1(2, 4) = 0
s1(2, 6) = 0
henkou = 4
Exit Sub
End If
If owari = 2 Then
owari = 0
End If
If hou = endhou And min = endmin Then
s1(2, 2) = 0
s1(2, 4) = 0
s1(2, 6) = 0
henkou = 4
Exit Sub
End If
If b2sign = "*" Then
sec = sec + kizamisec2
GoTo 11
End If
sec = sec + kizamisec1
11 Application.Wait [Now()] + wait_sec / 86400
If sec = 60 Then
sec = 0
s1(2, 6) = sec
DoEvents
GoTo 2
End If
s1(2, 6) = sec
DoEvents
GoTo 1
2 min = min + 1
If min = 60 Then
min = 0
s1(2, 4) = min
DoEvents
GoTo 3
End If
s1(2, 4) = min
DoEvents
GoTo 1
3 hou = hou + 1
If hou = 24 Then
hou = 0
End If
s1(2, 2) = hou
DoEvents
GoTo 1
myerror:
bhenkou = MsgBox("時計の倍率を変更します。", vbYesNo)
If bhenkou = 7 Then
bhenkou = 0
GoTo 11
End If
If b2sign = "" Then
GoTo 10
End If
b2sign = ""
wait_sec = wait1
If sec <> 0 Then
syo = sec \ kizamisec1
sec = kizamisec1 * syo
End If
GoTo 11
10 b2sign = "*"
wait_sec = wait2
If sec <> 0 Then
syo = sec \ kizamisec2
sec = kizamisec2 * syo
End If
GoTo 11
VBAエディタで標準モジュールを作って、コードを貼り付ける。
さあ、動かしてみましょう。
エクセルを開いて、時計を動かしてみましょう。
Sheet2に、必ず、動作に必要な情報を入力を入力してください。
コマンドボタン1で動作開始、
コマンドボタン2で速度切り替え、
コマンドボタン3で動作終了です。
※注意! 時計の刻み間隔が長いと、表示がおかしくなることがあります。
刻み間隔は、長くても10秒くらいがお勧めです。
うまく動作しない場合、コードの全体がコピーできていないことが考えられます。ご確認ください。
それでも動かない場合は、このサイト をご参照ください。
たとえ単純な運転でも、時計を見ながら運転すると、運転手気分が味わえますよ。
本日も、ご訪問ありがとうございました。