Excel

VBAで画像(図形・オートシェイプ)の指定位置をずれずに配置する

2021-11-20

連続でシートに画像を指定した位置に貼り付ける方法です。

注意

使用の環境によってはずれが生じる可能性があります。

複雑なグラフで大量のデータを配置した場合、パソコンのスペックによってはフリーズすることがあります。

グラフを画像として貼りつ付けではなく、グラフの画像を一度保存しその画像を挿入する方法もあります。

画像の配置例

フォルダ内に保存されているエクセルブックを開き、グラフシートを画像として別ブックのシートに貼り付けます。

貼り付けもとのデータ

グラフシートのあるエクセルブックの保存先:F:\sample

グラフのあるブック

このグラフシートを画像として保存します。

もとのグラフシート

貼り付け先

貼り付け先のエクセルブックです。貼り付け先の行列はこのシートに設定します。理由は、コード内で指定すると複雑になることと、一覧に入力しておくと変更する場合簡単なためです。

  • B列・ファイル名:拡張子なしのもとデータのファイル名
  • C列・行:貼り付け先の行番号(タイトル入力先)
  • D列・列:貼り付け先の列番号
  • E列・配置:画像を配置したら「済」と表示します
  • セルG1:ファイル保存先のパス
シート[一覧]

画像貼り付け後です。

シート[貼付先]

指定した行列に配置するサンプルコード

はじめに指定通りに配置できる例です。

サンプルコード

シート[一覧]をアクティブにした状態でマクロ実行する場合です。

Sub sample1()
    Dim sWB As Workbook, sWH As Worksheet, hWH As Worksheet
    Set sWB = ActiveWorkbook
    Set sWH = sWB.Worksheets("一覧")
    Set hWH = sWB.Worksheets("貼付先")
    Dim fPath As String: fPath = sWH.Cells(1, 7)
    Dim gNo As String, cName As String, fName As String
    Dim i As Long, r As Long, c As Long
    Dim shp As Shape
    Dim sCount As Long: sCount = 1    
    
    For i = 2 To sWH.Cells(Rows.Count, 1).End(xlUp).Row
        With sWH
             gNo = .Cells(i, 1)
             cName = .Cells(i, 2)
             r = .Cells(i, 3)
             c = .Cells(i, 4)
             fName = fPath & .Cells(i, 2) & ".xlsx"
        End With
    
        If Dir(fName) <> "" Then
             Workbooks.Open fName
             Charts(1).CopyPicture
             ActiveWorkbook.Close SaveChanges:=False
            
            hWH.Select
            With hWH
                    .Paste
                     Set shp = .Shapes(sCount)
                     hWH.Cells(r, c).Value = "No." & gNo & "_" & cName
             End With
             
             With shp
                 .Top = Cells(r + 1, c).Top
                 .Left = Cells(r + 1, c).Left
                 .LockAspectRatio = msoTrue
                 .Height = 280
            End With
             sCount = sCount + 1
            sWH.Cells(i, 5) = "済"
        End If
    Next i
End Sub

配置した図に名前(例:ファイル名の拡張子を除いた名前)を付けたい場合は、33行目のあとに「.Name = cName」を追加します。

説明

  • 12・42行目:For~Nextでシート一覧の2行目からA列最終行まで処理を繰り返します。
  • 13~19行目:シート[一覧]のA~D列までの値を変数設定、対象のファイルを指定します。
  • 21・41行目:フォルダ内に対象のファイルがあったら処理を実行します。
  • 22~24行目:対象のエクセルブックを開き、グラフシートを画像としてコピーし、ブックを保存せず閉じます。
  • 26行目:シート[貼付先]を選択します。
  • 28行目:シート[貼付先]に貼り付けます。
  • 29行目:画像を変数「shp」に設定します。画像の指定は変数「sCount)」で、一番初めの画像を「1」とひとつ増えるごとに変数もプラス1します。
  • 30行目:タイトル(画像の番号と名前)を設定します。
  • 34~35行目:画像を移動します。
  • 36~37行目:縦横比率を保ち、縦サイズのみの指定です。
  • 39行目:次の画像を貼り付けたときの画像番号
  • 40行目:シート[一覧]のE列に「済」と設定します。対象のエクセルブックがない場合は空欄です。

指定した場所からずれて配置される例

次の画像のように、指定した場所からずれて配置されることがあります。

ずれた例

画像を指定通りに配置する方法

「指定した行列に配置するサンプルコード」で記載していることをまとめると次の通りです。

  1. シート[貼付先]を選択するコードを入れる。
    26行目の「hWH.Select」
  2. 26行目の「hWH.Select」を使いたくない場合(シート[貼付先]を選択したくない)は、シート[貼付先]をアクティブにしてマクロを実行します。

参考

26行目の「hWH.Select」なしで、シート[一覧]をアクティブにしてマクロを実行すると、上の図のようにずれました。モニタの表示倍率を変更すると、多少の違いはありますが、ピッタリと配置はできません。データをコピーするときのズーム倍率を変更しても同じく指定通りに配置できません。

行方向は合っているので、幅の指定をしたら合うのかというと。

LockAspectRatio = msoFalse
Width = hWH.Cells(r + 1, c).Width * 8
Height = hWH.Cells(r + 1, c).Height * 22

縦横比率を保持せず、縦横サイズを指定してもずれます。

-Excel
-

© 2022 オフィスのQ&A