Option Explicit
Sub JpgInsert()
Dim Mypath As String, E As Range, x%, y% ', MyPic As Object
Mypath = "D:\JPG\"
Application.ScreenUpdating = False
With Sheets("Sheet1")
.Pictures.Delete '刪除全部圖片
For y = 0 To 9
For x = 0 To 2
Set E = Cells(5 + 8 * y, 1 + x * 3)
' E.Resize(8).ColumnWidth = 30 '調整儲存格寬度
' E.Resize(8).RowHeight = 20 '調整儲存格高度
If Dir(Mypath & E(2, 2) & ".jpg") <> "" Then
'Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
With .Pictures.Insert(Mypath & E(2, 2) & ".jpg")
.ShapeRange.LockAspectRatio = msoFalse '圖形比例 msoTrue / msoFalse=填滿格
.Left = E.Resize(8).Left
.Top = E.Resize(8).Top
.Width = E.Resize(8).Width '=儲存格寬度
.Height = E.Resize(8).Height '=儲存格高度
End With
End If
Next
Next
End With
Application.ScreenUpdating = True
End Sub
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/) |