| |
複数のフォルダがあり、フォルダ内に入っている写真をEXCELに貼り付けて
フォルダごとに保存していくマクロを実行したいと考えています。
フォルダに入っている名前がバラバラの写真jpg(最大６枚)を自動で貼り付ける
マクロを組んでいて、セル【J27】【K27】【L27】【J39】【K39】【L39】に
貼り付けて保存したいと考えています。
色々と調べたりして作成しているのですがうまくいきません。
ご教授宜しくお願いします。
下記がコードです。
Dim fpath As String, fname As String, tname As String
Dim x As Long, y As Long
Application.ScreenUpdating = False
fpath = "C:\" 'CドライブのDフォルダ内
tmpath = fpath & "d\" & (j.Cells(i, 1).Value) & "\" ’セル名前と一致しているファルダ
fname = Dir(tmpath & "*.jpg", vbNormal)
tname = tmpath & fname
y = 10
x = 10
Do Until fname = ""
If y < 13 Then
s.Cells(27, y).Select
With s.Pictures.Insert(tname)
.Left = Selection.Left
.Top = Selection.Top
.Width = Selection.Width
.Height = Selection.Height
End With
y = y + 1
Else
s.Cells(39, x).Select
With s.Pictures.Insert(tname)
.Left = Selection.Left
.Top = Selection.Top
.Width = Selection.Width
.Height = Selection.Height
End With
x = x + 1
End If
fname = Dir()
Loop
'Next x
Application.ScreenUpdating = True
w.SaveAs (p & "\E\" & j.Cells(i, 1).Value & ".xlsx") ’Eフォルダに名前をつけてxlsxで保存
w.Close
Next i
宜しくお願いします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 17/2/19(日) 11:14 -
