証左画像をエクセルに貼りつけるマクロ

ITソリューション事業部　エンジニアの塚本です。
写真は先月咲いていた河津桜です。
そろそろソメイヨシノも咲き出していますので、見物＋写真撮影いきたいものです。

さて、今回は技術ブログ的な内容を書いてみます。

【証左画像をエクセルに貼りつけるマクロを作成しました】
こういうのがちょちょいっと作れると評価業務でも役に立つ(はず)

流れとしては
画像をウインドウから選択する(複数選択可能)
↓
選択した画像を更新日順に入れ替える
↓
現在のセル位置を基準にしてエクセルに貼り付ける

という単純なもの

【以下作ったマクロ】
Option Explicit

‘ エビデンス作成
‘ テストのエビデンス用に選択した画像ファイルを縦に並べて挿入する。
Sub CreateEvidence()
　　’ 定数定義
　　’ 選択可能な画像の種類
　　Const PICTURE_TYPE As String = “画像ファイル, *.png; *.jpg; *.jpeg, すべてのファイル, *.*”
　　
　　’ 変数宣言
　　’ 挿入する画像ファイル配列
　　Dim fileNames As Variant
　　’ 画像ファイル名
　　Dim fileName As Variant
　　’ 画像
　　Dim activePicture As Shape
　　’ 画像の高さ
　　Dim pictureHeight As Double
　　’ 行の高さの合計
　　Dim totalRowHeight As Double
　　’ 初期位置のセル
　　Dim initCell As Range
　　’選択したファイル数
　　Dim filenum As Long
　　’更新日入れ替えカウント用
　　Dim i As Integer, i2 As Integer
　　’ソート用の一時オブジェクト
　　Dim temp As Object
　　’画像ファイルオブジェクトを格納するための配列
　　Dim gazofile() As Object
　　’ファイルシステムオブジェクト
　　Dim FSO As Object
　　Set FSO = CreateObject(“Scripting.FileSystemObject”)

　　’ スクリーンの描画を無効化
　　Application.ScreenUpdating = False
　　
　　’ 選択していたシートのセルを退避する
　　Set initCell = ActiveCell

　　’ ファイル選択
　　fileNames = Application.GetOpenFilename(PICTURE_TYPE, MultiSelect:=True)
　　If IsArray(fileNames) Then ‘配列かどうかを判断

　　　　’選択したファイル数を取得
　　　　filenum = UBound(fileNames, 1)
　　　　ReDim Preserve gazofile(filenum) As Object ‘ファイル数にあわせた配列を再定義
　　　　
　　　　’ 選択した画像数だけループ＋ファイル名を順番に取得
　　　　For Each fileName In fileNames
　　　　　　’ファイルオブジェクトをファイル名ごとに取得して、配列に格納
　　　　　　Set gazofile(i) = FSO.GetFile(fileName)
　　　　　　i = i + 1
　　　　Next fileName
　　　　’ファイルオブジェクトを解放
　　　　Set FSO = Nothing
　　　　’画像配列を並び替える、更新日が古い順に
　　　　For i = 0 To filenum – 2
　　　　　For i2 = i To filenum – 2
　　　　　If gazofile(i).DateLastModified > gazofile(i2 + 1).DateLastModified Then
　　　　　　　Set temp = gazofile(i)
　　　　　　　Set gazofile(i) = gazofile(i2 + 1)
　　　　　　　Set gazofile(i2 + 1) = temp
　　　　　End If
　　　　　Next
　　　Next

　　　　’ 選択した画像だけループ
　　　　For i = 0 To filenum – 1
　　　　　　’ 画像を挿入
　　　　　　Set activePicture = ActiveSheet.Shapes.AddPicture( _
　　　　　　　　fileName:=gazofile(i), _
　　　　　　　　LinkToFile:=False, _
　　　　　　　　SaveWithDocument:=True, _
　　　　　　　　Left:=Selection.Left, _
　　　　　　　　Top:=Selection.Top, _
　　　　　　　　Width:=0#, _
　　　　　　　　Height:=0# _
　　　　　　)
　　　　　　’ 画像サイズを元の画像サイズに対する比率で設定
　　　　　　With activePicture
　　　　　　　　　　　　.ScaleHeight 1, msoTrue
　　　　　　　　　　　　.ScaleWidth 1, msoTrue
　　　　　　　　pictureHeight = .Height
　　　　　　End With
　　　　　　
　　　　　　’ 画像の高さ分だけ行を下にずらす
　　　　　　totalRowHeight = 0
　　　　　　Do While totalRowHeight < pictureHeight
　　　　　　　　totalRowHeight = totalRowHeight + Rows.RowHeight
　　　　　　　　ActiveCell.Offset(1, 0).Activate
　　　　　　Loop
　　　　　　’ 1行分空ける
　　　　　　ActiveCell.Offset(1, 0).Activate
　　　　　　
　　　　Next
　　End If
　　
　　’ 最初に選択していたセルを選択
　　initCell.Activate
　　
　　’ スクリーンの描画を有効化
　　Application.ScreenUpdating = False
　　’ オブジェクトの解放
　　Set activePicture = Nothing
　　Set initCell = Nothing
　　　　Erase gazofile
End Sub

【んで、以下失敗したところ】
複数画像を選択しようとしたんだけど
Dim fileNames As Variant
Const PICTURE_TYPE As String = “画像ファイル, *.png; *.jpg; *.jpeg, すべてのファイル, *.*”
fileNames = Application.GetOpenFilename(PICTURE_TYPE, MultiSelect:=True)

返ってくるのが、オブジェクトだとばっかり思っていたので、そこで引っかかりました。
オブジェクトだと思ってからオブジェクト形式の配列として操作ができまへんでした。

取得に成功してたら文字列なんでした。
思い込みは良くない。

以上です。