VBA ดึงรูปแล้วเกิด error

[mr.zatan]

ความต้องการ : ดึงรูปมาแสดงอัตโนมัติ ตามชื่อที่ต้องการ
ปัญหา : ใส่รูปได้ปรกติ แต่เวลาจะแก้ไขหรือลบ จะเกิด error ทันที


ชื่ออยู่ที่ I31
รูปต้องการให้แสดงที่ B31

ที่ Sheet Print ทดสอบเลือกข้อมูลที่ I4 จะเกิด error ทันที

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("I")) Is Nothing Then Exit Sub
Dim myPict As Picture

With Cells(Target.Row, "B")
Set myPict = Cells(Target.Row, "B").Parent.Pictures.insert("D:\imagee\" & Target.Value & ".jpg")
    myPict.Top = .Top
    myPict.Width = .Width
    myPict.Height = .Height
    myPict.Left = .Left
    myPict.Placement = xlMoveAndSize
End With

End Sub

[snasui]

ตามที่อธิบายมา Set myPict ควรเป็นด้านล่างครับ

Set myPict = Cells(31, "B").Parent.Pictures.insert("D:\imagee\" & range("i31") & ".jpg")

[mr.zatan]

ขอบคุณครับ..

ผมขอเปลี่ยนโจทย์นิดนึงครับ

จาก Code เดิม

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("P")) Is Nothing Then Exit Sub
Dim myPict As Picture

With Cells(Target.Row, "O")
Set myPict = Cells(Target.Row, "O").Parent.Pictures.insert("D:\imagee\" & Target.Value & ".jpg")
    myPict.Top = .Top
    myPict.Width = .Width
    myPict.Height = .Height
    myPict.Left = .Left
    myPict.Placement = xlMoveAndSize
End With

End Sub

ชื่ออยู่ คอลัมน์ P
แสดงรูปที่ คอลัมน์ O

ปัญหาตอนนี้คือ ที่ คอลัมน์ P กดลบหรือแก้ไขชื่อ จะเกิด error ทันที

[snasui]

แนบไฟล์พร้อมรูปที่จะให้แสดงมาด้วยจะได้ช่วยทดสอบได้ครับ

[mr.zatan]

ตามไฟล์รูปและไฟล์แนบครับ

[logic]

ที่บอกว่าชื่ออยู่ในคอลัมน์ P ผมไม่เห็นว่ามีนะครับ ลองตรวจสอบไฟล์แนบอีกทีครับ

ผมอ่านแล้วเข้าใจว่าอาจารย์ให้แนบตัวอย่างรูปที่จะให้แสดงในไฟล์ จะได้เอาไปทดสอบได้

[mr.zatan]

ไฟล์พร้อมรูปครับ

[snasui]

วิธีการที่ใช้นั้นเป็นการดึงภาพจาก Web มาแสดง กรณีที่ต้องการดึงภาพที่เก็บไว้ในเครื่องมาแสดง ดูตัวอย่างได้ที่นี่่ครับ wordpress/picture-from-folder/

[mr.zatan]

วิธีการที่ใช้นั้นเป็นการดึงภาพจาก Web มาแสดง กรณีที่ต้องการดึงภาพที่เก็บไว้ในเครื่องมาแสดง ดูตัวอย่างได้ที่นี่่ครับ wordpress/picture-from-folder/

แต่ติดตรงที่ต้องกดปุ่ม รูปถึงจะโชวนี่สิ ครับ
คือผมอยากให้ใส่ชื่อเสร็จ enter รูปขึ้นมาเลยน่ะครับ.

[snasui]

อันนั้นไม่ใช่ปัญหา Code เดิมเป็นการเรียกใช้ Event

Code ที่ผมให้ไปก็เรียกใช้ Event ได้เช่นเดียวกัน และปกติแล้วไม่ว่า Code ไหน ๆ ก็เรียกใช้ผ่าน Event ได้ทั้งนั้น ขึ้นอยู่กับความต้องการ ลองปรับใช้ดูครับ

[mr.zatan]

ซึ่งตอนนี้ รูปยืดตามความกว้างของช่องครับ

จาก Code แก้ให้ Width เป็น Auto ได้มัยครับ

Code: Select all

 For Each r In ra
        Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:="D:\imagee\" & 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]

เอา Width:=r.Width, Height:=r.Height ออกหากไม่ต้องการปรับให้ความกว้างและความสูงภาพมีขนาดเท่าความกว้างและความสูงเซลล์ครับ

[mr.zatan]

ลบออกแล้ว error ครับ

Code: Select all

Sub STAMP_P4()
   Dim sFile As Variant, r As Range
    Dim imgIcon As Object
    Set r = Range("P4").MergeArea
    sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", _
        Title:="Browse to select a picture")
    If sFile = False Then Exit Sub
    
    Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:=sFile, _
        LinkToFile:=False, _
        SaveWithDocument:=msoCTrue, _
        Left:=r.Left, _
        Top:=r.Top)

End Sub

[snasui]

ขออภัยครับ .AddPicture จำเป็นต้องกำหนดตำแหน่งและความสูงความกว้าง ไม่สามารถละไว้ได้ครับ

ตัวอย่างการกำหนดแบบอื่น ๆ Top:= 100, Left:= 100, Width:= 70,Heigth:= 70 สามารถเปลี่ยนค่าตัวเลขได้ตามต้องการ

[mr.zatan]

สรุปคือ Width ไม่สามารถปรับเป็น Auto ได้ใช่มัยครับ

ผมแปลกใจทำมัย Code นี้รูปไม่ยืดด aspect ratio ถูกต้อง รูปไม่ยืด...

Code: Select all

With Cells(Target.Row, "B")
Set myPict = Cells(Target.Row, "B").Parent.Pictures.insert("D:\imagee\" & Target.Value & ".jpg")
    myPict.Top = .Top
    myPict.Width = .Width
    myPict.Height = .Height
    myPict.Left = .Left
    myPict.Placement = xlMoveAndSize
End With

[snasui]

สรุปคือ Width ไม่สามารถปรับเป็น Auto ได้ใช่มัยครับ

คำว่า "มัย" ที่ถูกต้องคือ "ไหม" หรือเขียนเป็น "หรือไม่" ครับ ส่วนคำตอบนั้นผมตอบไว้แล้วตามโพสต์ด้านบน

ที่รูปไม่ยืดตามความยาวเซลล์ผมทดสอบแล้วพบว่าเนื่องจากใช้กำหนดความสูงให้เท่าความสูงของเซลล์ หากไม่กำหนดความสูง จะทำให้รูปยืดเท่าความยาวเซลล์

เดิมผมทดสอบ Code นี้จากเครื่องคอมพิวเตอร์อีกเครื่อง พบว่าติด Error ดังที่แจ้งมา แต่สามารถแทรกภาพจาก Web ได้ เมื่อมาลองกับเครื่องปัจจุบันสามารถที่จะแทรกภาพที่มีอยู่ในเครื่องได้ปกติ ทั้ง ๆ ที่ Code นี้สามารถได้มาด้วยการบันทึก Macro