パラパラ漫画描き続けて10年の鉄拳に続けと、描いた作品をパソコンで実演できるプログラムを書いてみた ー UserForm1.Repaint（VBAコード）

      

本当は、パラパラ漫画をやりたくて、VBAコードを書いた分けでもありません。

短い間隔で画面を連続的に切り替えるスライドショーを作るのが目的だったの。

自分が関わっている仕事は、製品の輸出業務なのですが、梱包も関係するんだ。

常駐の専門業者が行いますが、梱包を証明するのにデジカメで撮影しています。

梱包物の内容が分かるように、包装物には製品カードを貼付けて、パシャリだ。

たまには、輸入者からパーツが梱包に入っていないとか、数量が足りないとか。

梱包日時の記録は取っているので、ファイルのタイムスタンプから確認します。

この間もクレームが起きて、どうやって確認しているのか、問い合わせました。

すると、撮影した画像をエクスプローラーでスクロールして検索するようです。

アイコンも大きい画像表示に切替えてあり、検索作業が便利になっていました。

そんな説明でしたが、色々と操作するよりもスライドショー一発はどうだろう。

0.1～0.2秒間隔のコマ送りで、画像が切り替われば、手を動かすことも不要だ。

だから、これをエクセルで作れないかと試行錯誤してコードを捻り出してみた。

でも、ユーザーフォームにイメージ画像を貼り付けても、全く切り替わらない。

シンプルなユーザーフォーム

　　　　

絵が一枚表示されたら、それだけで終了してしまって原因が特定できないんだ。

最初は、ループ処理に一時待機をするSleepコマンドができないのかと考えた。

でも、そういうのではなくて、ユーザーフォームを再描画するのが大切でした。

つまり、コマンドで画像へ貼り替えても、ディスプレイは以前の画像のままだ。

なので、ユーザーフォームを再表示させて、画像の更新を確実にさせる点です。

この説明が、ネットで検索しても意外と見つからなくて、時間がかかりました。

というわけで、作ってみるとパラパラ漫画の上映にもできると分かって面白い。

VBAコードでは、このブックを画像のあるフォルダーにおいて開くと実行を始める作りでして、コマ送り間隔は150ミリ秒なのですが、随時、自分のお好きなようにコードを書き換えてもらいたいとも思うのでした。

＜ThisWorkbookに記述＞

Private Sub Workbook_Open()

Dim i As Integer

  MsgBox "START!"

    Load UserForm1

      For i = 1 To 5 'パラパラ漫画５回繰り返し

        Call DataMaking

      Next i

End Sub

＜Module1に記述した＞

#If VBA7 Then 'Sleepコマンド、32/64ビット両方対応

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)

#Else

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

#End If

Option Explicit

Sub DataMaking()

Dim FsoObjct As Object, Fldr As Object, Strng As String, Fle As Object

Dim FleNme As String

  Set FsoObjct = CreateObject("Scripting.FileSystemObject")

    Strng = ""

    Strng = Strng & ThisWorkbook.Path

    Strng = Strng & ""

    Set Fldr = FsoObjct.GetFolder(Strng)

For Each Fle In Fldr.Files

  If Not (Right(Fle.Name, 3) = "jpg") Then GoTo Skip

    FleNme = ""

    FleNme = FleNme & Strng

    FleNme = FleNme & "\"

    FleNme = FleNme & Fle.Name

    FleNme = FleNme & ""

  Call JPGpaste(FleNme) '変数渡しのコール

Skip:

Next Fle

  Set FsoObjct = Nothing

End Sub

Private Sub JPGpaste(ByVal FleNme As String)

 UserForm1.Show vbModeless

 UserForm1.Image1.Picture = LoadPicture(FleNme)

 UserForm1.Repaint 'ユーザーフォーム再描画（ここがミソ）

 UserForm1.Image1.Picture = Nothing

 Sleep 150 'スリープ150ミリ秒

End Sub

＜UserForm1＞

Private Sub UserForm_Initialize()

  Me.Image1.Picture = Nothing

End Sub

いいねと思ったら、三つポチっとね！
  
にほんブログ村    にほんブログ村      にほんブログ村