color pencils

はやし@color_chipsです。
前回のVBAネタではPowerPointで画像貼り付けをやりました。
これってExcelでも出来るんじゃないかと流用してやってみたら出来たので、こちらも公開したいと思います。

さっそくコード

VBAのはじめ方は、こちらを参考にしてください。
今更ながらExcelVBAが便利な事に気づいた【解析屋さんのためのExcel VBA(01)：VBAの使い始め】 | ComputerScience - color pencils
以上で、VBAの実行の一連の流れです。 プログラムを色々書き込んで、繰り返し処理したり、たくさんのファイルを読み込んだり、通常のExcel関数では計算できないような演算をしたり、できます。 ...


出てきたVBAEditorに、以下のプログラミングコードをコピペします

'//[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]
'//[[ Function   : 現在のシートへ選択セル位置から画像を貼り付け          ]]
'//[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]
Sub addPhotoTilingSheet()
    '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]
    '//[[ 変数定義 ]]
    '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]
    Dim i As Integer
    ' ファイル操作
    Dim varFileName As Variant
    ' 貼り付ける画像のサイズ
    Dim iImageWidth As Integer
    Dim iImageHeight As Integer
    Dim dLPP As Double
    ' 画像オブジェクト
    Dim stImageShape As Shape
    ' 画像データの横に並べる数
    Dim iImageColumnCount As Integer
    ' 画像データ配置時の隙間指定
    Dim iMarginEdge As Integer
    Dim iMarginCellColumn As Integer
    Dim iMarginCellRow As Integer
    ' 初期選択セルの列数記憶
    Dim iStartRow As Integer
    Dim iStartColumn As Integer

    '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]
    '//[[ パラメータ指定 ]]
    '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]'
    '//[[ 画像データの横に並べる数の指定 ]]
    iImageColumnCount = 3
    '//[[ 画像データ配置の隙間 ]]
    iMarginCellColumn = 1
    iMarginCellRow = 1

    '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]
    '//[[ フォルダ選択 ]]
    '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]
    varFileName = Application.GetOpenFilename(FileFilter:="画像ファイル,*.bmp;*.png;*.jpg", _
                                        Title:="画像ファイルの選択", MultiSelect:=True)

    ' [[ ファイルパス取得できなかったら ]]
    If IsArray(varFileName) = False Then
        Exit Sub
    End If

    i = 1
    '//[[ 初期位置Column取得 ]]
    iStartRow = ActiveCell.Row
    iStartColumn = ActiveCell.Column
    '//[[ セル幅単位 ]]
    dLPP = ActiveCell.ColumnWidth / ActiveCell.Width
    ' [[ ファイルパス取得できたら ]]
    For Each Filename In varFileName
        ' [[ ファイルパスからファイル名を取得 ]]


        '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]
        '//[[ 画像の挿入
        '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]
        Set stImageShape = ActiveSheet.Shapes.AddPicture( _
            Filename:=Filename, _
            LinkToFile:=msoFalse, _
            SaveWithDocument:=msoTrue, _
            Left:=Selection.Left, _
            Top:=Selection.Top, _
            Width:=0, _
            Height:=0)

        '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]
        '//[[ 画像のサイズ復元（縦横比固定）
        '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]
        With stImageShape
            .LockAspectRatio = msoTrue
            .ScaleHeight 1, msoTrue
            .ScaleWidth 1, msoTrue
        End With

        '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]
        '//[[ 画像サイズ分のセルサイズ変更
        '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]
        If ActiveCell.Height < stImageShape.Height Then
            ActiveCell.RowHeight = stImageShape.Height
        End If
        If ActiveCell.Width < stImageShape.Width Then
            ActiveCell.ColumnWidth = stImageShape.Width * dLPP
        End If
        '//[[ セル移動 ]]
        If i Mod iImageColumnCount = 0 Then
            Cells(ActiveCell.Row + 1 + iMarginCellRow, iStartColumn).Select
        Else
            ActiveCell.Offset(0, 1 + iMarginCellColumn).Activate
        End If

        ' 10回に1度DoEvents（定期的にWindowsへ（ユーザーへ）制御を戻すため）
        i = i + 1
        If i Mod 10 = 0 Then
            DoEvents
        End If
    Next

    '//[[ 終了時にスタート位置へ戻る ]]
    Cells(iStartRow, iStartColumn).Select

    '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]
    '//[[ 終了処理]]
    '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]
    Set varFileName = Nothing
    Set stImageShape = Nothing

End Sub

使い方

「開発」タブから「マクロ」＞「addPhotoTilingSheet」選択＞「実行」してください。ファイル選択画面が出てきますので、1枚でも複数でも選択してください。

ソースコード内以下のパラメータを変更すると、並べ方を変える事ができます。
ちなみに『画像データ配置の隙間』は、画像間の隙間のセル数の指定です。

'//[[ 画像データの横に並べる数の指定 ]]
iImageColumnCount = 10
'//[[ 画像データ配置の隙間 ]]
iMarginCellColumn = 1
iMarginCellRow = 1

結果

できました。美味しそうですね（謎

連載記事

今更ながらExcelVBAが便利な事に気づいた【解析屋さんのためのExcel VBA(01)：VBAの使い始め】 | ComputerScience - color pencils
以上で、VBAの実行の一連の流れです。 プログラムを色々書き込んで、繰り返し処理したり、たくさんのファイルを読み込んだり、通常のExcel関数では計算できないような演算をしたり、できます。 ...

【解析屋さんのためのExcelVBA(2)】複数のデータファイル(csv)をひとつのExcelブックに読み込む | ComputerScience - color pencils
仕事柄、データ解析をすることが多いです。 実験で、いくつものパラメータを変更して得られた、 何十、何百の数のデータを、一つ一つ見ていかなきゃいけない。 途方に暮れてしまいます。 ...

【解析屋さんのためのExcelVBA(番外編)】PowerPointVBAで指定フォルダ内の画像を整列して並べる | ComputerScience - color pencils
VBAは何もExcelだけの特権ではありません。 PowerPointでもWordでもマクロは組めます。 ...