Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


61 / 13005 ツリー ←次へ | 前へ→

【78880】画像貼り付けについて emiko2001 17/2/19(日) 11:14 質問[未読]
【78881】Re:画像貼り付けについて β 17/2/19(日) 12:20 発言[未読]

【78880】画像貼り付けについて
質問  emiko2001 E-MAIL  - 17/2/19(日) 11:14 -

引用なし
パスワード
   複数のフォルダがあり、フォルダ内に入っている写真をEXCELに貼り付けて
フォルダごとに保存していくマクロを実行したいと考えています。

フォルダに入っている名前がバラバラの写真jpg(最大6枚)を自動で貼り付ける
マクロを組んでいて、セル【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


宜しくお願いします。

【78881】Re:画像貼り付けについて
発言  β  - 17/2/19(日) 12:20 -

引用なし
パスワード
   ▼emiko2001 さん:

学校のほうにコメントを入れましたので参照願います。

なお、学校も質問箱も、マルチ許容ですが、それぞれの掲示板として、マルチの場合のルールがあります。

質問箱でいえば、画面の上のほうの こちら というバナーをクリックすると見ることができますし
学校の場合も、初めての方へ というページの中に マルチ に関する方針が記載されています。

61 / 13005 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free