基礎から学ぶVBAプログラミング教室

もりさんのお題を解きながら楽しく勉強しよう

スポンサーリンク

【ExcelVBA】画像アニメーションマクロを作ってみた2

f:id:excel-accounting:20180506001859p:plain:w400

「アニメーションマクロを作ってみた」の第二弾です。(第一弾はこちら)

まずはこちらをご覧ください(動画)

※効果音あり




『なにこれ!絶対難しいことやってるー』

って思っていませんか。


このアニメーションマクロで使用しているのは、どれも有名で身近なステートメント・メソッドばかりですよ。

  • For~Next
  • Do~Loop
  • Select Case
  • Copyメソッド
  • Sleep関数

※Sleep関数とは
指定の時間(ミリ秒)処理を中断する関数です。

モジュールの宣言セクションにお決まりのフレーズを記述することで使用できます。
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

IE制御ではたまに使いますが、それ以外の会社の実務では使うことは少ないかもしれません。

たとえば、処理を1秒中断させたいときは
Sleep 1000
と書きます。


最後まで読んでいってくださいね~

f:id:excel-accounting:20180424002011p:plain:w150

事前設定

①Excelシートの行・列を同一幅に設定し、方眼紙のようにする。
(この記事では行列24ピクセルに設定)

f:id:excel-accounting:20180805140844p:plain:w400

②ExcelオプションでR1C1形式に設定。
列番号が数値で表示されるので、cells(r, c)の列番号が確認しやすくなります。

f:id:excel-accounting:20180317224828p:plain:w450

f:id:excel-accounting:20180805140857p:plain:w400

画像の準備

描画に動きをつけるため、2パターンの絵を用意します。

パターン1→パターン2→パターン1→・・・

と、2つの画像を交互に表示することで動きをつけるパラパラ漫画のような仕組みです。


背景黒で作成(シート名は"オリジナル画像"としておく)

f:id:excel-accounting:20180505230356p:plain:w300

※画像の赤枠線は、Rangeオブジェクトに格納する範囲です

マクロ実行用シートの準備

「オリジナル画像」シートとは別にマクロ実行用のシートを用意して下記2点の準備をします。

①方眼紙形式
行列の幅をオリジナル画像シートと同じ幅(24ピクセル)に設定

②セルを全面黒色で塗りつぶし

ソースコード

Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim r As Long, c As Long '画像の座標
Dim Pattern1 As Range '画像パターン1
Dim Pattern2 As Range '画像パターン2

Sub アニメーションマクロ()

    Dim ws As Worksheet
    Set ws = Sheets("オリジナル画像")
    
    '3行ずつ下に降りていくので、画像を上書きできるよう余分にセットしている
    Set Pattern1 = Range(ws.Cells(2, 2), ws.Cells(65, 15))
    Set Pattern2 = Range(ws.Cells(2, 18), ws.Cells(65, 31))
    
    r = 10: c = 10 'スタート位置
    
    Dim interval As Long '画像同士の間隔設定
    interval = 17
    
    Dim imagecnt As Long '画像数(0~xまで)
    imagecnt = 9
    
    Dim movecnt As Long '左右の移動回数

    Dim i As Long '左右の往復回数
    
    For i = 1 To 2 ' ---------移動開始--------------
    
        Do Until movecnt = 10 '右への移動回数
        
            Call 画像移動(interval, imagecnt)
            c = c + 1 '次の画像コピー先を1列右へ移動
            movecnt = movecnt + 1
            Sleep 100
            DoEvents
        
        Loop
    
        r = r + 3 '3行下へ移動
        c = c - 1 '1列左へ移動
        
        Do Until movecnt = 0 '右へ移動した回数分、左に戻る
        
            Call 画像移動(interval, imagecnt)
            c = c - 1 '次の画像コピー先を1列左へ移動
            movecnt = movecnt - 1 '移動回数
            Sleep 100
            DoEvents
        
        Loop
        
        r = r + 3 '3行下へ移動
        c = c + 1 '1列右へ移動
      
    Next i

End Sub

Sub 画像移動(ByVal interval As Long, imagecnt As Long)

    Dim n As Long
    
    '※For文で1オブジェクトずつコピーするためいったん画面更新を止める
    Application.ScreenUpdating = False
    
    Select Case c Mod 2
    
        Case 0 '偶数列の場合、画像パターン1を表示する
        
            For n = 0 To imagecnt
                Pattern1.Copy Destination:=Cells(r, c + interval * n)
            Next n
            
        Case 1 '奇数列の場合、画像パターン2を表示する
        
            For n = 0 To imagecnt
                Pattern2.Copy Destination:=Cells(r, c + interval * n)
            Next n
    
    End Select
    
    '画面更新を再開
    Application.ScreenUpdating = True

End Sub


スポンサーリンク


おおまかな動き

ざっくりこんな風に動いてます。

f:id:excel-accounting:20180805174234p:plain:w500

画面更新・停止処理

1つの画像Rangeを合計10個、1RangeずつFor~Next文でコピー貼り付けしています。

そのため、画面更新したままでは各オブジェクトのコピー貼り付けに若干のタイムラグが生じてしまい、アニメーションが美しくないのです。

そこで、画面更新をいったん止めてから、

Application.ScreenUpdating = False

画像Range×10をコピー貼り付けして、

画面更新を再開する(アニメーション再開)
Application.ScreenUpdating = True

という流れにしています。

画像の貼り付け

For n = 0 To imagecnt
    Pattern1.Copy Destination:=Cells(r, c + interval * n)
Next n

貼り付け先の列番号を示す
c + interval * n
がちょっと難しいですね。

【図解】

このような仕組みで全10個の画像Rangeを配置しています。

f:id:excel-accounting:20180506003720p:plain

(参考)
f:id:excel-accounting:20180506004133p:plain

最後に

このようにステートメント・メソッドの使い方・組み合わせ方次第で、おもしろいマクロが作れちゃうんですね!

f:id:excel-accounting:20180428154537p:plain:w150


「VBAは仕事で使うもの」って思ってるみなさん!

こちらもオススメですよ!

【連載】VBAでナンプレを解いてみよう


たくさん読んでいってくださいね!

スポンサーリンク