- Sub FindFile()
- Dim Arr, i&, pth$, ML, MT, MW, MH, shp, s$, fNm$, s1$
- Application.ScreenUpdating = False
- Myr = [d65536].End(xlUp).Row
- Arr = Range("a3:g" & Myr)
- pth = ThisWorkbook.Path & ""
- Call FindFileName(pth)
- k = d.keys
- For Each shp In ActiveSheet.Shapes
- If shp.Type = msoAutoShape Then
- shp.Delete
- End If
- Next
- For i = 1 To UBound(Arr)
- s1 = Arr(i, 2) & Arr(i, 3) & Arr(i, 4)
- s = s1 & ".jpg"
- If s = ".jpg" Then GoTo 100
- If d.exists(s) Then
- fNm = d(s)
- Else
- GoTo 100
- End If
- With Cells(i + 2, 5)
- ML = .Left
- MT = .Top
- MW = .Width
- MH = .Height
- ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
- Selection.ShapeRange.Fill.UserPicture fNm
- End With
- With Cells(i + 2, 6)
- ML = .Left
- MT = .Top
- MW = .Width
- MH = .Height
- ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
- Selection.ShapeRange.Fill.UserPicture Split(fNm, ".")(0) & "2.jpg"
- End With
- 100:
- Next
- Application.ScreenUpdating = True
- End Sub
复制代码 |