趣味プログラミングblog

---

まずは「ファイル一覧解析マクロ」
で紹介した方法で、CMDからDirコマンドを実行し、
その結果をエクセルで取り込んでjpgファイルのフルパスを取得。
そのパスのファイルを選択セルに順次貼り付けていく。

表示された写真を見て、不要なものは
写真の隣のセルにCMDの削除コマンド（del /q フルパス）を関数で作成。

無事に要らない写真を消すことができた。


注意点として、外付けデバイスを直接見に行く場合は
エクセルとドライブが違うため、以下のアラートが出る。

1004実行時エラー
pictures クラスのinsertプロパティを取得できません。
（ファイルは確かにあるのにファイルがないと言ってる）

Call ChDrive(drive:=Left(フルパス, 2)) のようにドライブを指定すればOK。


今回は即興だったので、あまり凝らずに作成。
凝って汎用的なものを作ろうとすると、別用途で使おうとしたときに
大きすぎて使いづらかったり。塩梅が難しい。

以下、ソース。ソースコードファイルは こちら。

---

Sub inportPhoto(fName)
If Right(Trim(fName), 3) = "jpg" Then
If Dir(fName) <> "" Then
Call ChDrive(drive:=Left(fName, 2))
With ActiveSheet.Pictures.Insert(fName)
.Top = Selection.Top
.Left = Selection.Left
.Width = Selection.Width
End With
End If
End If
End Sub

Sub inportPhotoLists()

Dim stGyo As Long: stGyo = 2
Dim edGyo As Long: edGyo = Cells(Rows.Count, "A").End(xlUp).Row

Application.ScreenUpdating = False
Dim Gyo As Long
For Gyo = stGyo To edGyo
Application.StatusBar = Gyo - stGyo & "/" & edGyo - stGyo
DoEvents
If Cells(Gyo, "F") = "jpg" Then
Cells(Gyo, "G").Select
Call inportPhoto(Cells(Gyo, "A").Value)
End If
Next Gyo
Application.ScreenUpdating = True
End Sub

Sub 削除_シート内のすべてのオブジェクトを削除() 'Ctrl+F10でオブジェクトリスト

Dim tobj As Shape

'ワークシートの全オブジェクト数をループ
For Each tobj In ActiveSheet.Shapes
'オブジェクトを削除
tobj.Delete
Next
End Sub