回答編集履歴
3
コード修正
test
CHANGED
|
@@ -89,6 +89,6 @@
|
|
|
89
89
|
Left:=targertCell.Left, _
|
|
90
90
|
Top:=targertCell.Top, _
|
|
91
91
|
Width:=-1, _
|
|
92
|
-
Height:=
|
|
92
|
+
Height:=-1
|
|
93
93
|
End Sub
|
|
94
94
|
```
|
2
コード修正
test
CHANGED
|
@@ -88,6 +88,7 @@
|
|
|
88
88
|
SaveWithDocument:=True, _
|
|
89
89
|
Left:=targertCell.Left, _
|
|
90
90
|
Top:=targertCell.Top, _
|
|
91
|
+
Width:=-1, _
|
|
91
92
|
Height:=430
|
|
92
93
|
End Sub
|
|
93
94
|
```
|
1
コード追記
test
CHANGED
|
@@ -40,3 +40,54 @@
|
|
|
40
40
|
[VBA シートを追加する](https://www.tipsfound.com/vba/10003)
|
|
41
41
|
|
|
42
42
|
[エクセルVBAで大量の画像をまとめてシートに貼り付けるAddPictureメソッドの使い方](https://tonari-it.com/excel-vba-shapes-addpicture-batch/)
|
|
43
|
+
|
|
44
|
+
---
|
|
45
|
+
上記のコードに、下記の処理を追加する参考コードです。
|
|
46
|
+
|
|
47
|
+
- サブフォルダー名で新規シートの追加、追加先は末尾
|
|
48
|
+
- 追加したシートにサブフォルダー内のpng画像を挿入
|
|
49
|
+
|
|
50
|
+
```vba
|
|
51
|
+
Sub PicInsert()
|
|
52
|
+
'変数はVariant型ではなく適切な型で宣言した方がよい
|
|
53
|
+
Dim f As Object
|
|
54
|
+
Dim Path As String
|
|
55
|
+
Dim FileName As String
|
|
56
|
+
Dim newWorkSheet As Worksheet
|
|
57
|
+
Dim targertCell As Range
|
|
58
|
+
|
|
59
|
+
Path = Range("A1").Value 'セルにあらかじめTestまでのディレクトリを入れておく
|
|
60
|
+
|
|
61
|
+
With CreateObject("Scripting.FileSystemObject")
|
|
62
|
+
'サブフォルダーを順に取得
|
|
63
|
+
For Each f In .GetFolder(Path).SubFolders 'サブフォルダーオブジェクトを順に取得
|
|
64
|
+
|
|
65
|
+
'新規シートを末尾に追加して名前をフォルダー名に
|
|
66
|
+
Set newWorkSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
|
|
67
|
+
newWorkSheet.Name = f.Name
|
|
68
|
+
Set targertCell = newWorkSheet.Range("A1") '画像挿入セル
|
|
69
|
+
|
|
70
|
+
FileName = Dir(f.Path & "\*.png") 'サブフォルダー内のpngファイル名を取得
|
|
71
|
+
Do Until FileName = "" '次のファイル名がなくなるまで繰り返す
|
|
72
|
+
|
|
73
|
+
AddPicture f.Path & "\" & FileName, targertCell
|
|
74
|
+
Set targertCell = targertCell.Offset(25, 0) '画像挿入セルを25行下へ移動
|
|
75
|
+
|
|
76
|
+
FileName = Dir() '次のファイル名を取得
|
|
77
|
+
Loop
|
|
78
|
+
Next f
|
|
79
|
+
End With
|
|
80
|
+
|
|
81
|
+
End Sub
|
|
82
|
+
|
|
83
|
+
'画像挿入サブルーチン
|
|
84
|
+
Sub AddPicture(ImgFileName As String, targertCell As Range)
|
|
85
|
+
targertCell.Parent.Shapes.AddPicture _
|
|
86
|
+
FileName:=ImgFileName, _
|
|
87
|
+
LinkToFile:=False, _
|
|
88
|
+
SaveWithDocument:=True, _
|
|
89
|
+
Left:=targertCell.Left, _
|
|
90
|
+
Top:=targertCell.Top, _
|
|
91
|
+
Height:=430
|
|
92
|
+
End Sub
|
|
93
|
+
```
|