標題:
求助照片排列問題
[打印本頁]
作者:
naknay
時間:
2020-9-22 18:28
標題:
求助照片排列問題
小弟練習排列插入圖片.結果圖片沒有案到我想要位置排列
列如 200917-14 這張圖 我要排在 A17 這存格內
始終都跑到別邊~
是否有大大可以幫忙 幫我看一下 是哪邊寫錯
附上檔案
感謝各位大大
作者:
ikboy
時間:
2020-9-23 13:00
Sub zz()
Dim p, pic, pn$, Newpic As Object, k
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select the images folder"
.Show
If .SelectedItems.Count Then p = .SelectedItems(1) & "\" Else Exit Sub
End With
Sheets(2).Activate
pic = Dir(p & "*.jpg")
Do While Len(pic) > 0
pn = Mid(Split(pic, ".")(0), 3)
k = Split(pn, "-")
pn = Format(k(0), "0000") & "-" & k(1)
Set Rng = Cells.Find(pn)
If Rng Is Nothing Then MsgBox "No picture " & pic: GoTo 1000
Set Rng = Range(Rng.MergeArea.Address)
For Each op In ActiveSheet.Pictures
If Not Application.Intersect(Rng, op.TopLeftCell) Is Nothing Then op.Delete
Next
Set Newpic = ActiveSheet.Pictures.Insert(p & pic)
With Newpic
.ShapeRange.LockAspectRatio = msoFalse
.Top = Rng.Top
.Left = Rng.Left
.Height = Rng.Height
.Width = Rng.Width
End With
1000
pic = Dir
Loop
End Sub
複製代碼
作者:
naknay
時間:
2020-9-23 13:28
回復
2#
ikboy
謝謝大大分享 我知道問題所在了 感恩
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)
