Snasui Excel Forum

Code: Select all

Sub ShowPicture() 'ชื่อ Sup Procedure จะเป็นชื่ออะไรก็ได้ ถ้าเขียนให้สื่อความหมายว่าต้องการทำอะไรก็จะยิ่งดี
Dim r As Range, ra As Range 'การประกาศตัวแปรให้ r, ra เป็นช่วงข้อมูล
Dim imgIcon As Object 'การประกาศตัวแปรให้ imgIcon เป็น Object
Dim obj As Object 'การประกาศตัวแปรให้ obj เป็น Object
On Error Resume Next 'Code สำหรับการกำหนดว่าแม้มี Error ก็ยังคงให้ Run Code ต่อไป
With Worksheets("Sheet1") 'กำหนดว่าบรรทัดในช่วง With..End With เป็นการกำหนดค่าใน Sheet1
    Set ra = .Range("G4", .Range("F65536").End(xlUp).Offset(0, 1)) 'กำหนดให้ตัวแปร ra มีค่าเท่ากับช่วง G4:Gn (n คือค่าสุดท้ายที่มีข้อมูล)
 End With
 For Each obj In ActiveSheet.Shapes 'กำหนดการ Loop ค่า Object ทั้งหมดในชีทปัจจุบัน
    If Left(obj.Name, 4) = "Pict" Then 'ถ้า Object นั้นมี 4 อักขระหน้าของชื่อเป็นคำว่า "Pict" แล้ว 
        obj.Delete 'ให้ลบ Object นั้น
    End If 
Next obj 'ไปยัง Object ถัดไป
For Each r In ra 'กำหนดการ Loop แต่ละเซลล์ให้ช่วง ra ที่กำหนดไว้ด้านบน
    Set imgIcon = ActiveSheet.Shapes.AddPicture( _
    Filename:="D:\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
    SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
    Width:=r.Width, Height:=r.Height) 'ให้นำภาพตามชื่อที่อยู่ในเซลล์ด้านซ้ายของแต่ละเซลล์ ใน Folder D: โดยชื่อของภาพต้องมีนามสกุลเป็น .jpg มาแสดง โดยให้ความสูง ความกว้างพอดีกับเซลล์ (จะกำหนดนามสกุลภาพเป็นอย่างอื่นก็ต้องเปลี่ยน .jpg เป็นค่าอื่น)
Next r 'ไปยังเซลล์ถัดไป
End Sub