ต้องการให้ VBA แทรกรูปมากกว่า 1 column

[Phupay]

ถ้าใส่ชื่อรูปที่ Column B เพื่อให้แสดงที่ column C แล้ว
อยากให้ ใส่ชื่อรูปที่ Column E เพื่อให้แสดงที่ column F ด้วย ต้องแก้ไข code ยังไงคะ
ไฟล์มีขนาดใหญ่เกินไป ไม่สามารถแนบได้ค่ะ


Sub ShowPicture()
Dim r As Range, ra As Range
Dim imgIcon As Object
Dim obj As Object
On Error Resume Next
With Worksheets("Sheet1")
Set ra = .Range("C6", .Range("B" & .Rows.Count) _
.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:\" & 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

[snasui]

กรุณาโพสต์ Code มาใหม่พร้อมแนบไฟล์ประกอบครับ

การโพสต์ Code จำเป็นต้องให้มีรูปแบบเป็น Code จะได้สะดวกต่อการอ่านและคัดลอกไปทดสอบ ดูวิธีการได้ที่หัวข้อการใช้บอร์ดข้อ 5 ด้านบนครับ

[Phupay]

Code: Select all

Sub ShowPicture()
    Dim r As Range, ra As Range
    Dim imgIcon As Object
    Dim obj As Object
    On Error Resume Next
    With Worksheets("Sheet1")
        Set ra = .Range("C6", .Range("B" & .Rows.Count) _
            .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:\" & r.Offset(0, -1).Value & ".jpg", _
            LinkToFile:=False, saveWithDocument:=True, _
            Left:=r.Left, Top:=r.Top, _
            Width:=r.Width, Height:=r.Height)
    Next r

[snasui]

แนบไฟล์ Excel ที่เขียน Code นี้เอาไว้แล้วมาด้วยครับ

[Phupay]

ทำการแนบรูปที่ Screenshot อยู่ด้านบนค่ะ อาจารย์

[logic]

ยังไม่เห็นไฟล์ excel ครับ