เพิ่มรูปด้วย VBA
Posted: Fri Jul 01, 2016 10:28 am
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, ra As Range
Dim imgIcon As Object
Dim obj As Object
On Error Resume Next
With Worksheets("image")
Set ra = .Range("B5", .Range("C65536").End(xlUp).Offset(0, 1))
End With
For Each obj In ActiveSheet.Shapes
If Left(obj.Name, 4) = "Pict" Then
obj.Delete
End If
Next obj
For Each r In ra
Set imgIcon = ActiveSheet.Shapes.AddPicture( _
Filename:="D:\image\large_images\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
Width:=r.Width, Height:=r.Height)
Next r
End Sub
------------------------------------------------------------------------
จาก Code ด้านบนตรง Range("C65536") สามารถเปลี่ยนได้ไหมครับ
เพราะตอนนี้รูปขึ้นมาสุดที่แถว 217 หลังจากแถวนี้ไปรูปไม่ขึ้น ไม่รู้ว่าเป็นเพราะตัวนี้รึเปล่าว
Dim r As Range, ra As Range
Dim imgIcon As Object
Dim obj As Object
On Error Resume Next
With Worksheets("image")
Set ra = .Range("B5", .Range("C65536").End(xlUp).Offset(0, 1))
End With
For Each obj In ActiveSheet.Shapes
If Left(obj.Name, 4) = "Pict" Then
obj.Delete
End If
Next obj
For Each r In ra
Set imgIcon = ActiveSheet.Shapes.AddPicture( _
Filename:="D:\image\large_images\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
Width:=r.Width, Height:=r.Height)
Next r
End Sub
------------------------------------------------------------------------
จาก Code ด้านบนตรง Range("C65536") สามารถเปลี่ยนได้ไหมครับ
เพราะตอนนี้รูปขึ้นมาสุดที่แถว 217 หลังจากแถวนี้ไปรูปไม่ขึ้น ไม่รู้ว่าเป็นเพราะตัวนี้รึเปล่าว