トップ　>　汎用コード　>　画像を変更しながらの印刷

' ***（宣言セクションに記述）***
'-------------------------------
' Win32API
'-------------------------------
'《指定時間スレッドを中断》
' https://learn.microsoft.com/ja-jp/windows/win32/api/synchapi/nf-synchapi-sleep
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub アクティブシートの全シェイプを基準セル位置に順に表示し印刷()

    '-------------------------
    ' 定数
    '-------------------------
    Const REFERENCE_CELL_ADDRESS As String = "B3"   ' 基準セルアドレス
    Const WAITING_TIME           As Long = 500      ' 待機時間（ミリ秒）
    Const PREVIEW_FLAGS          As Boolean = True  ' 印刷プレビューフラグ
                                                    '   True：印刷プレビュー　False：印刷
    '-------------------------
    ' 変数
    '-------------------------
    Dim dblRefCellTop            As Double          ' 基準セルTop
    Dim dblRefCellLeft           As Double          ' 基準セルLeft
    Dim dblShapeTop              As Double          ' シェイプTop
    Dim dblShapeLeft             As Double          ' シェイプLeft
    Dim shpTarget                As Shape           ' シェイプオブジェクト
    
    '-------------------------
    ' メイン処理
    '-------------------------
    Application.ScreenUpdating = False
    
    ' 基準セルのTop・Left位置を代入
    dblRefCellTop = ActiveSheet.Range(REFERENCE_CELL_ADDRESS).Top
    dblRefCellLeft = ActiveSheet.Range(REFERENCE_CELL_ADDRESS).Left
    
    For Each shpTarget In ActiveSheet.Shapes
        ' シェイプのTop・Left位置を代入
        dblShapeTop = shpTarget.Top
        dblShapeLeft = shpTarget.Left
        
        ' 基準セル位置にシェイプを移動
        shpTarget.Top = dblRefCellTop
        shpTarget.Left = dblRefCellLeft
        DoEvents
        
        ' 指定時間待機
        Call Sleep(WAITING_TIME)
        
        If PREVIEW_FLAGS Then
            ' 印刷プレビュー
            ActiveSheet.PrintPreview
        Else
            ' 印刷
            ActiveSheet.PrintOut
        End If
        
        ' シェイプを元の位置に移動
        shpTarget.Top = dblShapeTop
        shpTarget.Left = dblShapeLeft
        DoEvents
    Next

    Application.ScreenUpdating = True
End Sub