ดึงรูป VBA กด Show รูปหนึ่ง อีกรูปหนึ่งหาย

[zixnutz]

ผมทำการดึงรูปโดยใช้ VBA แต่เกิดปัญหาคือ

เมื่อผมกดปุ่ม Show Picture 1 รูปขึ้นปกติ
แต่พอกดปุ่ม Show Picture 2 รูปของ Picture 2 ขึ้นแต่รูปของ Picture 1 หายไปครับ
ไม่ทราบว่าต้องแก้ไขตรงไหนครับ ดูแล้วสับสนมากครับ

ซึ่งตอนนี้ผมทดลองแค่ ปุ่ม Show Picture 1 ถึง 3 ครับ

หมายเหตุ ไม่สามารถแนบไฟล์ได้ครับ ขึ้นว่า ไฟล์มีขนาดใหญ่เกินไป

Code: Select all

Sub ShowPicture1()
    Dim r1 As Range, i As Integer, ButName As String
    Dim imgIcon1 As Object
    Dim obj As Object
    ButName = Application.Caller
    i = Val(Mid(ButName, InStr(1, ButName, " ")))
    Select Case i
        Case Is = 1: Set r1 = Range("e6")
        Case Is = 2: Set r1 = Range("e8")
        Case Is = 3: Set r1 = Range("e10")
        Case Is = 4: Set r1 = Range("e12")
        Case Is = 5: Set r1 = Range("e14")
        Case Is = 6: Set r1 = Range("e16")
        Case Is = 7: Set r1 = Range("e18")
        Case Is = 8: Set r1 = Range("e20")
        Case Is = 9: Set r1 = Range("e22")
        Case Is = 10: Set r1 = Range("e24")
        Case Is = 11: Set r1 = Range("e26")
        Case Is = 12: Set r1 = Range("e28")
        Case Is = 13: Set r1 = Range("e30")
        Case Is = 14: Set r1 = Range("e32")
        Case Is = 15: Set r1 = Range("e34")
        Case Is = 16: Set r1 = Range("e36")
        Case Is = 17: Set r1 = Range("e38")
        Case Is = 18: Set r1 = Range("e40")
        Case Is = 19: Set r1 = Range("e42")
        Case Is = 20: Set r1 = Range("e44")
        Case Is = 21: Set r1 = Range("e46")
        Case Is = 22: Set r1 = Range("e48")
        Case Is = 23: Set r1 = Range("e50")
        Case Is = 24: Set r1 = Range("e52")
        Case Is = 25: Set r1 = Range("e54")
        Case Is = 26: Set r1 = Range("e56")
        Case Is = 27: Set r1 = Range("e58")
        Case Is = 28: Set r1 = Range("e60")
        Case Is = 29: Set r1 = Range("e62")
        Case Is = 30: Set r1 = Range("e64")
        Case Is = 31: Set r1 = Range("e66")
        Case Is = 32: Set r1 = Range("e68")
        Case Is = 33: Set r1 = Range("e70")
        Case Is = 34: Set r1 = Range("e72")
        Case Is = 35: Set r1 = Range("e74")
        Case Is = 36: Set r1 = Range("e76")
        Case Is = 37: Set r1 = Range("e78")
        Case Is = 38: Set r1 = Range("e80")
        Case Is = 39: Set r1 = Range("e82")
        Case Is = 40: Set r1 = Range("e84")
        Case Is = 41: Set r1 = Range("e86")
        Case Is = 42: Set r1 = Range("e88")
        Case Is = 43: Set r1 = Range("e90")
        Case Is = 44: Set r1 = Range("e92")
    End Select
    For Each obj In ActiveSheet.Shapes
        If obj.Left = r1.Left Then _
            obj.Delete
    Next obj
    Set imgIcon1 = ActiveSheet.Shapes.AddPicture( _
        Filename:="D:\PicFoam\" & r1.Offset(, -1) & " (1).jpg", _
        linktofile:=False, savewithdocument:=True, Left:=r1.Left, _
        Top:=r1.Top, Width:=r1.MergeArea.Width, Height:=r1.MergeArea.Height)
End Sub

[logic]

โค้ดชุดนี้มันลบรูปเดิมออกก่อนครับ

Code: Select all

For Each obj In ActiveSheet.Shapes
	If obj.Left = r1.Left Then _
		obj.Delete
Next obj

ลองทำให้เป็นคอมเมนต์หรือลบออกไปก่อนแล้วทดสอบดูอีกทีครับ

[zixnutz]

ขอบพระคุณมากครับ ได้แล้วครับ