|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Option Explicit
Sub TEST2()
Dim ar, i&, strPath$, strFileName$, shp As Shape
Application.ScreenUpdating = False
For Each shp In ActiveSheet.Shapes
If shp.Type = 11 Then shp.Delete
Next
strPath = ThisWorkbook.Path & "\图片文件\"
With [A1].CurrentRegion
ar = .Value
For i = 1 To UBound(ar)
strFileName = strPath & ar(i, 1) & ".jpg"
If Dir(strFileName) <> "" Then
.Cells(i, 2).Select
ActiveSheet.Pictures.Insert(strFileName).Select
With Selection
.ShapeRange.LockAspectRatio = msoFalse
.Height = ActiveCell.RowHeight
.Width = ActiveCell.Width
.Placement = xlMoveAndSize
End With
End If
Next i
End With
Application.ScreenUpdating = True
Beep
End Sub
|
评分
-
2
查看全部评分
-
|