図形の貼付け

カレンダーの指定位置に図形（イラスト）を貼り付けて、
１２枚連続印刷します

カレンダーの印刷
貼り付ける画像
図形のインデックス番号
画像の貼付け
画像位置の調整方法
1. ①Top/Leftプロパティを使う
2. ②セルを選択して貼り付け
OSに制御を戻す
1. DoEvents関数とは
画像の重なり
図形の削除
画像を背面に
実行ボタン作成
最後に
プログラムコード

カレンダーの印刷

カレンダーの作成

　　このカレンダーを印刷します
　　Box型カレンダーの作り方はこちらを見てね！

開運カレンダー解説
 開運データ2024年版

カレンダーをリンクされた図として貼り付け

カレンダーをコピーし、”印刷”シートに
貼り付けのオプション→
形式を選択して貼り付け→リンクされた図

このように、カレンダーを参照していればOK！

リンクされているので、
カレンダーの月を変更すれば、
印刷シートの月も変更される

リンクされたカレンダーを印刷

カレンダーのH1セルに1～12まで代入し、
印刷シートをPrintPreviewしてみましょう！
カレンダーと印刷シートは、リンクしているので、１２か月分印刷できる
イラストがいらない場合は、これで終了～

Sub イラスト付き開運カレンダー印刷()
Dim i As Long                                             '月を表す　1～12

For i = 1 To 12
　　Worksheets("カレンダー").Range("h1").Value = i         'カレンダーの月を1～12まで指定する
　　Worksheets("印刷").PrintPreview
Next i

貼り付ける画像

貼り付けるイラスト等を12枚用意する
”イラスト”シートに貼り付る
画像データ容量が大きいので、圧縮しておきましょう！

【Windows & EXCEL】画像の圧縮　画像方式・圧縮率による画質の比較　どの方式で圧縮するべき？　簡単なリサイズ方法　解像度とは　EXCELで圧縮すると意外な結果に…

画像の圧縮について考察しました。ファイルサイズを軽くして、作業を効率化しましょう！お役に立てば、うれしいです。＜参考動画＞画像の貼り付け　も見てね！0:00はじめに0:35画像圧縮方式について2:00画像データを圧縮する方法...

　　Short　Ver.はこちら　画像の圧縮ペイント３Dでリサイズ

この辺に貼り付けるので、
適当な大きさのイラストを用意
12枚おおよそ同じぐらいの
大きさにしてね！

【EXCEL】Excelデータの背景に画像の貼り付け！　すぐに役立つ　Excel中級編　　図の書式設定も少しだけ解説しています。

カレンダーに背景画像を貼付けます。図の書式設定も説明しています。①EXCELの初級編で縦型のカレンダーを作成しています。　カレンダーの基本的な作り方を学びたい人は、　初級編のカレンダー作成を見てください。②EXCELの初級～中級編でボックス型カレンダーを作成しています。　ボックス型カレンダーの作り方を学びたい人は...

図形のインデックス番号

貼り付けた順番にインデックス番号が振られる
図形は、貼り付けた順に重なる
12枚目の図形が１番上の図形

通常、作成（貼り付け）順＝重なり順だが、
図形を削除すると、
インデックス番号はふり直される
例）11枚目の図形を削除→
　　12枚目のインデックス番号は、
　　11に変更される

画像の貼付け

画像をコピーする
コピーされたデータは、
クリップボードに格納される

Shapesとは…
画像・オートシェイプ・グラフなどのすべての図形のこと

Worksheets(“イラスト”).Shapes(i).Copy
Worksheets(“印刷”).Paste

イラストシートのインデックス番号 i 番目の図形をCopyし、
クリップボードの値を印刷シートにPaste
カーソルのある位置に貼り付けられる

インデックス番号の取得

Selectした図形のインデックス番号は、以下で確認できます

Sub Shapeインデックス番号()
　　Debug.Print Selection.ShapeRange.ZOrderPosition
End Sub

Sub イラスト付き開運カレンダー印刷()
Dim i As Long                                         '月を表す　1～12

For i = 1 To 12
　　Worksheets("カレンダー").Range("h1").Value = i 　   'カレンダーの月を1～12まで指定する
　　Worksheets("イラスト").Shapes(i).Copy　　　　　　　　'イラスト　コピー
　　Worksheets("印刷").Paste　　　　　　　　　　　　　　　'クリップボードのデータを印刷シートにペースト
　　Worksheets("印刷").PrintPreview
Next i

画像位置の調整方法

①Top/Leftプロパティを使う

セル範囲の上端からの距離と左端からの距離をポイント単位で取得

Pasteされた画像を
F列42行に移動させる

図形の左位置←A～F列距離
図形の上位置←1～42行距離

For i = 1 To 12
    Worksheets("カレンダー").Range("h1").Value = i      'カレンダーの月を1～12まで指定する
    Worksheets("イラスト").Shapes(i).Copy               'イラスト　コピー
    Worksheets("印刷").Paste                            'クリップボードのデータを印刷シートにペースト

    Selection.ShapeRange.Left = Range("f42").Left　  　 '図形の左の位置F列に
    Selection.ShapeRange.Top = Range("f42").Top　　　　　'図形の上の位置42行に

    Worksheets("印刷").PrintPreview
Next i

②セルを選択して貼り付け

もっとスッキリとした方法もあります

印刷シートのセルを選択、その位置に貼り付け
（印刷シートがActiveSheetとなる）

Worksheets(“印刷”).Range(“f42”).Select
ActiveSheet.Paste

F42セルをSelectして　

貼り付け

For i = 1 To 12
    Worksheets("カレンダー").Range("h1").Value = i      'カレンダーの月を1～12まで指定する
    Worksheets("イラスト").Shapes(i).Copy               'イラスト　コピー
   
　　 Worksheets("印刷").Range("f42").Select             'F42セルを選択
     ActiveSheet.Paste                                 'クリップボードのデータを選択位置にペースト

'    Selection.ShapeRange.Left = Range("f42").Left　  　'図形の左の位置F列に
'    Selection.ShapeRange.Top = Range("f42").Top　　　　'図形の上の位置42行に

     ActiveSheet.PrintPreview
Next i

OSに制御を戻す

DoEvents関数とは

画像を貼り付けるなど時間のかかる処理の場合、うまく実行できないときがある

DoEvents関数は、処理の途中にオペレーティングシステムに制御を移すための関数です。時間のかかる処理やループ処理の場合、処理が完了するまでOS(オペレーティングシステム）は制御を行うことができません。（ループ処理中は、OSやExcelそのものにも再描画をさせる暇さえ与えません。）
そこで、DoEvents関数を利用することで一時的にOS（オペレーティングシステム）に制御を移して、処理を行うことができます。長期のループ処理や無限ループ処理に陥った場合に利用されたりします。ただし、使いすぎると処理は安定しますが、処理時間が長くなってしまうこともあるので注意しましょう。
無限ループ対策で使用すれば、Escキーで回避することができるので、便利な関数でもあります。

エクセルVBAのDoEvents関数

DoEvents
あるいは、Application.Wait Now + TimeValue(“00:00:01”)

どちらかを加え、OSに制御を移す

For i = 1 To 12
    Worksheets("カレンダー").Range("h1").Value = i      'カレンダーの月を1～12まで指定する
    Worksheets("イラスト").Shapes(i).Copy               'イラスト　コピー
   
　　 Worksheets("印刷").Range("f42").Select             'F42セルを選択

　　　DoEvents　　　　　　　　　　　　　　　　　　　　　　　'OSに制御を移す
 　  'Application.Wait Now + TimeValue("00:00:01")
     
     ActiveSheet.Paste                                  'クリップボードのデータを選択位置にペースト

'    Selection.ShapeRange.Left = Range("f42").Left　  　'図形の左の位置F列に
'    Selection.ShapeRange.Top = Range("f42").Top　　　　'図形の上の位置42行に

     ActiveSheet.PrintPreview
Next i

画像の重なり

最後の画像(12月)を
移動させると11月の画像が…

1～12月まで、インデックス番号順に画像が重なっている

貼り付ける前に、
前の画像を削除する必要がある

図形の削除

ActiveSheet.Shapes.SelectAll …シートのすべての図形を選択
Selection.ShapeRange.delete …選択した図形を削除
ActiveSheet.Shapes(1).delete…インデックス番号1の図形を削除

Selection.ShapeRange.ZOrderPosition…インデックス番号の取得

カレンダーも図形である
図形をすべて削除できない

カレンダー以外の図形を削除したいので、
印刷シートのカレンダーをクリックし、
”カレンダー”と名前を付ける

貼り付けるイラストを取り出す変数
Dim myShape As Shape

Shapeを削除
myShape.Delete

画像を貼り付ける前に、名前を付けたカレンダー以外の画像を削除

　　Dim myShape As Shape              '貼り付けるイラストを取り出す変数  
 　　　　
　　For i = 1 To 12
        
        Worksheets("カレンダー").Range("h1") = i　　'カレンダーの月を1～12まで指定する

        Worksheets("印刷").Activate
        
        For Each myShape In ActiveSheet.Shapes　　　'Shapeの数だけループする

            If myShape.Name <> "カレンダー" Then
                
                myShape.delete　　　　　　　　　　　　'カレンダー以外を削除する

            End If

       　Next myShape

イラストのみ削除　　　　　　　

色々な削除方法

画像取得方法

前の画像を削除した後に、Copyした画像をPaste

　　 Worksheets("イラスト").Shapes(i).Copy               'イラスト　コピー
   
　　 Worksheets("印刷").Range("f42").Select             'F42セルを選択

　　　DoEvents　　　　　　　　　　　　　　　　　　　　　　　'OSに制御を移す
 　  'Application.Wait Now + TimeValue("00:00:01")
     
     ActiveSheet.Paste                                  'クリップボードのデータを選択位置にペースト

'    Selection.ShapeRange.Left = Range("f42").Left　  　 '図形の左の位置F列に
'    Selection.ShapeRange.Top = Range("f42").Top　　　　　'図形の上の位置42行に

     ActiveSheet.PrintPreview
Next i

画像を背面に

Excelで図の書式
背面へ移動

背面へ移動　Or
最背面へ移動を
選ぶのと同じ

最背面：Selection.ShapeRange.ZOrder msoSendToBack
　背　面：Selection.ShapeRange.ZOrder msoSendBackward
カレンダーとイラストの2枚のみなので、どちらでもOK！

　　　　'クリップボードのデータを印刷シートにペースト
        ActiveSheet.Paste
        
        '右下の位置(f42)に移動
'        Selection.ShapeRange.Left = Range("f42").Left
'        Selection.ShapeRange.Top = Range("f42").Top

        'イラストを背面に移動
        Selection.ShapeRange.ZOrder msoSendBackward
        
        'ActiveSheet.PrintOut
        ActiveSheet.PrintPreview
    Next i
    
     'カレンダーシートをアクティブに戻す
    Worksheets("カレンダー").Activate
    
End Sub

実行ボタン作成

実行ボタンをイラスト付き開運カレンダー印刷と紐付けますが、
実行ボタンも図形なので、このシートに作成すると削除されてしまう
（カレンダー以外を削除しているので）

For Each myShape In ActiveSheet.Shapes
　　If myShape.Name <> “カレンダー” Then
　　　　myShape.delete　　’カレンダー以外を削除する
　　End If
Next myShape

ActiveSheetのShapesを
削除するので、
他のシートのShapeは
削除されない

カレンダーシートに実行ボタンを作る

最後に

他のシートはActiveしないので
Worksheets(“印刷”).Activateは、
ループの前に1度設定すればOK！

Worksheets(“カレンダー”).Activate
カレンダーシートをActiveにして終わる

プログラムコード

Sub イラスト付き開運カレンダー印刷()

    Dim i As Long               　    '月を表す　1～12
    Dim myShape As Shape              '貼り付けるイラストを取り出す変数   
    
    Worksheets("印刷").Activate         '印刷シートをアクティブはこの位置に！
        
    For i = 1 To 12
        'カレンダーの月を1～12まで指定する
        Worksheets("カレンダー").Range("h1") = i
        
        'Shapeの数だけループする
        For Each myShape In ActiveSheet.Shapes
            If myShape.Name <> "カレンダー" Then
                'カレンダー以外を削除する
                myShape.delete
            End If
        Next myShape
        
        'イラスト　コピー
        Worksheets("イラスト").Shapes(i).Copy
        'セルを選択
        ActiveSheet.Range("f42").Select
        
        DoEvents
        'Application.Wait Now + TimeValue("00:00:01")
        
        'クリップボードのデータを印刷シートにペースト
        ActiveSheet.Paste
        
        '右下の位置(f42)に移動
'        Selection.ShapeRange.Left = Range("f42").Left
'        Selection.ShapeRange.Top = Range("f42").Top

        'イラストを背面に移動
        Selection.ShapeRange.ZOrder msoSendBackward
        
        'ActiveSheet.PrintOut
        ActiveSheet.PrintPreview
    Next i
    
     'カレンダーシートをアクティブに戻す
    Worksheets("カレンダー").Activate
    
End Sub

Sub Shape削除()
    'ActiveSheet.Shapes.SelectAll 　　'すべての図形を選択
    Selection.ShapeRange.delete 　　　'選択した図形を削除
    ActiveSheet.Shapes(1).delete　　 '1番に作成された図形を削除
End Sub

 Sub Shapeインデックス番号()
    Debug.Print Selection.ShapeRange.ZOrderPosition
 End Sub

【EXCEL VBA】図形の貼付け＆印刷　Shapeを学びましょう　画像を貼付けながら、開運カレンダーを印刷します　春の土用が終わりました　もうすぐ夏ですね！

【EXCELVBA】図形の貼付け＆印刷指定位置に画像を貼付けながら、開運カレンダーを１２枚印刷します図形インデックス番号、図形の重なり、図形の位置、Object.Left・Object.Top、ShapeRange、図形の削除、ForEach、前面/背面に移動、実行ボタンが消えた訳とは？、エラー対応、DoEve...