メインコンテンツまでスキップ

Excelに貼り付けた画像を全て同じサイズに変更するVBA

thumbnail

記事作成日: 2019/12/09
記事更新日: 2019/12/09

あらすじ​

Excelにスクリーンショットや画像を貼って、
それらを全て同じサイズにトリミングすることがあります。
１つずつ画像をトリミングしていくのはとても時間が勿体無いし、
微妙に誤差がでるので、VBAを使って綺麗に統一することにしました。

TL;DR1​

同じサイズの画像が貼られたExcelシートを用意する
シートにVBAを貼り付けて調整する
実行するとシート内の全画像が同じサイズに削られる

前提条件​

  • シート内にある画像が全て同じサイズであること
  • VBAコードはシート単位に処理するため適宜コードをペーストして実行すること
  • コードを実行するとundoできない（元に戻せない）ためバックアップファイルを用意すること

実施手順​

Excelにスクリーンショット等の画像を貼り付け​

Excelシートに画像を貼り付けます。

VBAのコードを貼り付ける画面に移動​

画像が貼られているシートを右クリックして「コードを表示」を選択します。

赤枠部分がコード入力欄になります。

VBAコードを貼り付ける​

下記のコードをコード入力欄に貼り付けます。

Sub main()
    Const CutTop As Double = 0 '上の切り取り
    Const CutLeft As Double = 0 '左の切り取り
    Const CutBottom As Double = 300 '下の切り取り
    Const CutRight As Double = 200 '右の切り取り
    Dim ws As Worksheet
    Dim sp1 As Shape
    Set ws = ActiveSheet
    
    Dim i As Integer
    i = 1
    
    For i = 1 To ws.Shapes.Count
        Set sp1 = ws.Shapes(i)
        With sp1
            .PictureFormat.CropTop = CutTop
            .PictureFormat.CropLeft = CutLeft
            .PictureFormat.CropBottom = CutBottom
            .PictureFormat.CropRight = CutRight
        End With
    Next
    
End Sub


コードの説明​

重要なのは以下の部分 

Const OffTop As Double = 0 '上の切り取り
Const OffLeft As Double = 0 '左の切り取り
Const OffBottom As Double = 300 '下の切り取り
Const OffRight As Double = 200 '右の切り取り

画像の上下左右端からそれぞれどれぐらいの幅を削除するかという内容になってます。
上記コードの例を説明すると、
下部分（Bottom）を300、右部分（Right)を200ほど切り取るという内容になります。

数値は最初は小さい値で実行し、
徐々に大きい値に変更して実行するのが良いです。

コードを実行する​

F5キーまたはメニューバーから実行することで動きます。

よいVBAライフを～

以上

  1. Too long; Didn't readの略。長すぎて読む気がないという意味。↩