Sub PicturesInsert()
Attribute PicturesInsert.VB_ProcData.VB_Invoke_Func = "f \n14"
Dim i, arr, str, typ, shp
On Error Resume Next '忽略運行中可能出現的錯誤
Application.ScreenUpdating = False '關閉工作表更新，提高運行速度
Set mysheet1 = ThisWorkbook.Worksheets("Sheet1") '定義Sheet1工作表
arr = Array(".jpg", ".jpeg", ".png", ".bmp", ".gif", ".tif") '圖片格式集合
For Each shp In mysheet1.Shapes
If shp.Left > mysheet1.Columns("A").Left And shp.Left < mysheet1.Columns("C").Left Then
shp.Delete '如果是E列單元格里邊的圖片，則刪除
End If
Next
For i = 2 To 1000 '從第2行到1000行 （如果標題欄有1欄，這里就是2 to 100，有2欄改為3）
If mysheet1.Cells(i, 1) <> "" Then '如果A列對應的單元格不為空白，則執行
For Each typ In arr '執行圖片格式組里面的每一個嘗試
str = "\\192.168.1.100\Pictures\" & mysheet1.Cells(i, 1).Value & typ '圖片路徑 (“1”代表圖片的名稱在第1列)
If Dir(str) <> "" Then '如果圖片存在，則執行
mysheet1.Pictures.Insert(str).Select '插入圖片並選擇
With Selection.ShapeRange
.LockAspectRatio = msoFalse '不鎖定圖片的比例
.Height = mysheet1.Cells(i, 2).Height - 4 '圖片的高度設為單元格高度-4 （“2”代表存放圖片到第2列）
.Width = mysheet1.Cells(i, 2).Width - 4 '圖片的寬度設為單元格高度-4
.Top = mysheet1.Cells(i, 2).Top + 2 '圖片的位置為E列對應單元格到頂部的距離+2
.Left = mysheet1.Cells(i, 2).Left + 2 '圖片的位置為E列對應單元格到左側的距離+2
End With
mysheet1.Cells(i, 2) = "" '清空E列對應單元格的內容
Exit For '導入圖片后，退出For循環
Else
mysheet1.Cells(i, 2) = "圖片不存在" '否則將顯示“圖片不存在”
End If
Next
End If
Next
mysheet1.Cells(i + 1, 2).Select
Application.ScreenUpdating = True '恢復更新顯示
End Sub