Excelマクロで複数画像を一括トリミングの手法【朝勉累計1,050分】

この記事ではこんなお悩みを解決します。

どうもヤドリです。

昨日のことでした。ゲームトレードに売るアカウントの画像情報を編集しようとスマホのスクリーンショットを編集するときに、大量のスマホスクリーンショット画像をトリミングすることになりました。

いろいろ調べると一括で処理できましたので、ご紹介いたします。

条件は同じサイズの画像を同じ位置、同じ大きさでトリミングすることです。

Excelマクロの記録とコード編集で可能

Excelマクロの記録とコード編集で可能です。

何枚でも、一瞬で終わります。

まず、マクロの記録で1枚の画像をトリミングしましょう。

するとこのようなコードができます。

必要なのは赤いマーカー部分です。

Sub Macro2()
    ActiveSheet.Shapes.Range(Array("Picture 15")).Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.IncrementTop 57.3751181102
    Selection.ShapeRange.ScaleWidth 0.8390714827, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.8528843422, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 338
    Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 791
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 24
    Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 20
 End Sub

次に黄色のマーカー部分を足しましょう。

マクロの記録でできたコードの「Selection」を消しましょう。

Option Explicit
Sub Macro1()
Dim i
For Each i In ActiveSheet.Pictures
　With i
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.IncrementTop 57.3751181102
    .ShapeRange.ScaleWidth 0.8390714827, msoFalse, msoScaleFromTopLeft
    .ShapeRange.ScaleHeight 0.8528843422, msoFalse, msoScaleFromTopLeft
    .ShapeRange.PictureFormat.Crop.PictureWidth = 338
    .ShapeRange.PictureFormat.Crop.PictureHeight = 791
    .ShapeRange.PictureFormat.Crop.PictureOffsetX = 24
    .ShapeRange.PictureFormat.Crop.PictureOffsetY = 20


 End With
Next i
End Sub

使いどころ

使いどころは、、

• ゲームを売るときのスマホスクリーンショットの画像編集
• 定点撮影した画像の編集

などではないでしょうか？

他にも画像を処理する方には有効な手段になりえます。

まとめ

あっという間です。

使いどころは少ないかもしれませんが、久しぶりに感動しました。

2021年9月4日の勉強

floatの基礎① – 初心者のためのWEBデザイナーの教科書 (cocohp.com)

これが練習の成果です。

float(回り込み)プロパティ – 初心者のためのWEBデザイナーの教科書 (cocohp.com)

これが練習の成果です。