返回列表 上一主題 發帖

求助照片排列問題

求助照片排列問題

小弟練習排列插入圖片.結果圖片沒有案到我想要位置排列   
列如 200917-14   這張圖 我要排在 A17 這存格內

始終都跑到別邊~
是否有大大可以幫忙 幫我看一下 是哪邊寫錯

附上檔案

感謝各位大大

照片排列.rar (804.19 KB)

照片檔案

  1. Sub zz()
  2. Dim p, pic, pn$, Newpic As Object, k
  3. With Application.FileDialog(msoFileDialogFolderPicker)
  4.     .Title = "Select the images folder"
  5.     .Show
  6.     If .SelectedItems.Count Then p = .SelectedItems(1) & "\" Else Exit Sub
  7. End With
  8. Sheets(2).Activate
  9. pic = Dir(p & "*.jpg")
  10. Do While Len(pic) > 0
  11.     pn = Mid(Split(pic, ".")(0), 3)
  12.     k = Split(pn, "-")
  13.     pn = Format(k(0), "0000") & "-" & k(1)
  14.     Set Rng = Cells.Find(pn)
  15.     If Rng Is Nothing Then MsgBox "No picture " & pic: GoTo 1000
  16.     Set Rng = Range(Rng.MergeArea.Address)
  17.     For Each op In ActiveSheet.Pictures
  18.         If Not Application.Intersect(Rng, op.TopLeftCell) Is Nothing Then op.Delete
  19.     Next
  20.     Set Newpic = ActiveSheet.Pictures.Insert(p & pic)
  21.     With Newpic
  22.         .ShapeRange.LockAspectRatio = msoFalse
  23.         .Top = Rng.Top
  24.         .Left = Rng.Left
  25.         .Height = Rng.Height
  26.         .Width = Rng.Width
  27.     End With
  28. 1000
  29. pic = Dir
  30. Loop
  31. End Sub
複製代碼

TOP

回復 2# ikboy


    謝謝大大分享  我知道問題所在了 感恩

TOP

        靜思自在 : 君子為目標,小人為目的。
返回列表 上一主題