Excelに複数の写真を挿入する場合…

質問

Excelで工事写真帳を作っていて、その写真帳のあるセルに写真を貼りつけて、写真の横にコメントが書けるようになっています。１ページに３枚の写真を貼りつけられるので、１枚ずつ挿入するのではなく、複数の写真を選択して挿入したいのですが、貼りつけたい順番に写真を選択→挿入すると、微妙に順番が変わって挿入されてしまいます。
試しに貼りつけたい順番の逆から選択→挿入してみたのですが、このときは貼りつけたい順番どおりに挿入されました。これはどうしてなのでしょうか？
また、この写真帳作成でもっといい方法があれば、教えていただきたいです。よろしくお願いします。

回答No.2

KenKen_SP

こんにちは。KenKen_SP です。

挿入してから手動で並べ替えるのは、ダメなのですか？

> 順番の逆から選択→挿入してみたのですが、このときは貼りつけたい順番
> どおりに挿入されました。

それは、たまたまの上手くできただけであって、選択順は無関係ですね。確証
はないのですが、選択されたファイルを HDD から探し、見つけた順番に画像が
挿入されるのだと思います。

任意の選択順...というのは特殊な仕組みを作らないと無理です。プログラム
を組むことになりますが、結構複雑になりそうです。

また、ファイル名順であれば、こちらもプログラムは必要ですが、比較的に
簡易なもので可能です。一例を紹介しておきます。

Sub 複数の画像を挿入()

　　Dim strFilter As String
　　Dim Filenames As Variant
　　Dim PIC　　　 As Picture

　　' 「ファイルを開く」ダイアログでファイル名を取得
　　strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
　　Filenames = Application.GetOpenFilename( _
　　　　　　　　　　FileFilter:=strFilter, _
　　　　　　　　　　Title:="図の挿入(複数選択可）", _
　　　　　　　　　　MultiSelect:=True)
　　If Not IsArray(Filenames) Then Exit Sub

　　' ファイル名をソート
　　Call BubbleSort_Str(Filenames, True, vbTextCompare)

　　' 貼り付け開始セルを選択
　　Range("C5").Select

　　' マクロ実行中の画面描写を停止
　　Application.ScreenUpdating = False
　　' 順番に画像を挿入
　　For i = LBound(Filenames) To UBound(Filenames)
　　　　Set PIC = ActiveSheet.Pictures.Insert(Filenames(i))

　　　　'-------------------------------------------------------------
　　　　' 画像の各種プロパティ変更
　　　　'-------------------------------------------------------------
　　　　With PIC
　　　　　　.Top = ActiveCell.Top　　　　' 位置：アクティブセルの上側に重ねる
　　　　　　.Left = ActiveCell.Left　　　' 位置：アクティブセルの左側に重ねる
　　　　　　.Placement = xlMove　　　　　' 移動するがサイズ変更しない
　　　　　　.PrintObject = True　　　　　' 印刷する
　　　　End With
　　　　With PIC.ShapeRange
　　　　　　.LockAspectRatio = msoTrue　 ' 縦横比維持
　　　　　　' 画像の高さをアクティブセルにあわせる
　　　　　　' 結合セルの場合でも対応
　　　　　　.Height = ActiveCell.MergeArea.Height
　　　　End With

　　　　' 次の貼り付け先を選択（アクティブセルにする）[例：5個下のセル]
　　　　ActiveCell.Offset(5).Select

　　　　Set PIC = Nothing
　　Next i

　　' 終了
　　Application.ScreenUpdating = True
　　MsgBox i & "枚の画像を挿入しました", vbInformation

End Sub

' バブルソート（文字列）
Private Sub BubbleSort_Str( _
　　ByRef Source As Variant, _
　　Optional ByVal SortAsc As Boolean = True, _
　　Optional ByVal Compare As VbCompareMethod = vbTextCompare)

　　If Not IsArray(Source) Then Exit Sub

　　Dim i As Long, j As Long
　　Dim vntTmp As Variant
　　For i = LBound(Source) To UBound(Source) - 1
　　　　For j = LBound(Source) To LBound(Source) + UBound(Source) - i - 1
　　　　　　If StrComp(Source(IIf(SortAsc, j, j + 1)), _
　　　　　　　　　　　 Source(IIf(SortAsc, j + 1, j)), Compare) = 1 Then
　　　　　　　　vntTmp = Source(j)
　　　　　　　　Source(j) = Source(j + 1)
　　　　　　　　Source(j + 1) = vntTmp
　　　　　　End If
　　　　Next j
　　Next i

End Sub

お礼

詳しい回答ありがとうございました。
“プログラムを組む”ことまでしないと、貼りつけたい順番どおりにはいかないのですね(>_<)
プログラムうんぬんまでＰＣに詳しくないので、一例を示していただきましたが、私の手には負えないようです。