VBA Generic code

画像を変更しながらの印刷

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秒。

ページトップへ戻る
Copyright(C) 2009- 坂江 保 All Rights Reserved.