画像を変更しながらの印刷2023.06.10
Excelに取り込んだシート上の画像を順番に表示し印刷したい。
そのような時に使用するマクロです。
【お薦め】マクロ・プロシージャを管理する無料のツール！
Excelマクロ管理ツール
Excelマクロ管理ツール
サンプルコード予め「印刷範囲の設定」を行っておく必要があります
コードの貼り付け場所
次の例は、シート上にある画像を、セル[B3]の位置に順番に表示し印刷を行います。
'標準モジュールの先頭に記述します。 #If VBA7 Then 'Excel2010以上の場合 Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) #Else 'Excel2007以下の場合 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If
Sub All_Images_PrintOut() 'シート上の全ての画像を順番に表示しながら印刷する '定数 Const conCell As String = "B3" 'セル番地 Const conWait As Long = 100 '待機時間。ミリ秒 '変数 Dim dblTop(1 To 2) As Double Dim dblLeft(1 To 2) As Double Dim objImage As Shape With Application .ScreenUpdating = False dblTop(1) = .Range(conCell).Top dblLeft(1) = .Range(conCell).Left With .ActiveSheet For Each objImage In .Shapes With objImage dblTop(2) = .Top dblLeft(2) = .Left .Top = dblTop(1) .Left = dblLeft(1) DoEvents Call Sleep(conWait) ActiveSheet.PrintOut .Top = dblTop(2) .Left = dblLeft(2) DoEvents End With Next End With .ScreenUpdating = True End With End Sub
次は連番の名前を付けた画像を順に印刷する例です。
サンプルコードでは「Image_1」～「Image_40」の名前のついた画像を、セル[B3]に順番に表示し印刷を行います。
'標準モジュールの先頭に記述します。 #If VBA7 Then 'Excel2010以上の場合 Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) #Else 'Excel2007以下の場合 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If
Sub Images_PrintOut() '連番の名前がついた画像を順番に表示しながら印刷する '定数 Const conStart As Long = 1 '開始番号 Const conEnd As Long = 40 '終了番号 Const conStep As Long = 1 '間隔 Const conCell As String = "B3" 'セル番地 Const conShape As String = "Image_" '画像名 Const conWait As Long = 100 '待機時間 '変数 Dim lngI As Long Dim dblTop(1 To 2) As Double Dim dblLeft(1 To 2) As Double With Application .ScreenUpdating = False dblTop(1) = .Range(conCell).Top dblLeft(1) = .Range(conCell).Left With .ActiveSheet For lngI = conStart To conEnd Step conStep With .Shapes(conShape & lngI) dblTop(2) = .Top dblLeft(2) = .Left .Top = dblTop(1) .Left = dblLeft(1) DoEvents Call Sleep(conWait) ActiveSheet.PrintOut .Top = dblTop(2) .Left = dblLeft(2) DoEvents End With Next End With .ScreenUpdating = True End With End Sub
定数を変更することで、様々な状況に対応出来ます。
・「開始番号」 1番から40番までの印刷だと、1番の事です。
・「終了番号」 1番から40番までの印刷だと、40番の事です。
・「間隔」 通常は「1」ですが、一つ飛ばしにする場合は「2」にします。
・「セル番地」画像を移動する際の基準となるセルです。基準のセルの位置に、画像の左上が合わさります。
・「画像名」 画像の名前です。予め「画像名」+「連番」にしておく必要があります。
・「待機時間」 画像が上手く印刷されない場合は、この値を増やして下さい。1000=1秒。
