- 帖子
- 262
- 主題
- 8
- 精華
- 0
- 積分
- 280
- 點名
- 17
- 作業系統
- xp
- 軟體版本
- Office 2007
- 閱讀權限
- 20
- 性別
- 男
- 來自
- HK
- 註冊時間
- 2015-8-11
- 最後登錄
- 2024-11-19
|
2#
發表於 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
|
|
