ดึงรูป VBA กด Show รูปหนึ่ง อีกรูปหนึ่งหาย
Posted: Mon Oct 16, 2017 1:12 pm
ผมทำการดึงรูปโดยใช้ VBA แต่เกิดปัญหาคือ
เมื่อผมกดปุ่ม Show Picture 1 รูปขึ้นปกติ
แต่พอกดปุ่ม Show Picture 2 รูปของ Picture 2 ขึ้นแต่รูปของ Picture 1 หายไปครับ
ไม่ทราบว่าต้องแก้ไขตรงไหนครับ ดูแล้วสับสนมากครับ
ซึ่งตอนนี้ผมทดลองแค่ ปุ่ม Show Picture 1 ถึง 3 ครับ
หมายเหตุ ไม่สามารถแนบไฟล์ได้ครับ ขึ้นว่า ไฟล์มีขนาดใหญ่เกินไป
เมื่อผมกดปุ่ม 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
