Page 1 of 1

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

Posted: Wed Feb 17, 2016 11:22 am
by 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

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

Posted: Wed Feb 17, 2016 4:57 pm
by snasui
:D ตามที่อธิบายมา Set myPict ควรเป็นด้านล่างครับ

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

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

Posted: Wed Feb 17, 2016 5:12 pm
by 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 ทันที

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

Posted: Wed Feb 17, 2016 5:14 pm
by snasui
:D แนบไฟล์พร้อมรูปที่จะให้แสดงมาด้วยจะได้ช่วยทดสอบได้ครับ

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

Posted: Wed Feb 17, 2016 5:23 pm
by mr.zatan
ตามไฟล์รูปและไฟล์แนบครับ

Image

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

Posted: Wed Feb 17, 2016 5:30 pm
by logic
ที่บอกว่าชื่ออยู่ในคอลัมน์ P ผมไม่เห็นว่ามีนะครับ ลองตรวจสอบไฟล์แนบอีกทีครับ

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

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

Posted: Wed Feb 17, 2016 5:45 pm
by mr.zatan
ไฟล์พร้อมรูปครับ

Image

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

Posted: Wed Feb 17, 2016 7:12 pm
by snasui
:D วิธีการที่ใช้นั้นเป็นการดึงภาพจาก Web มาแสดง กรณีที่ต้องการดึงภาพที่เก็บไว้ในเครื่องมาแสดง ดูตัวอย่างได้ที่นี่่ครับ wordpress/picture-from-folder/

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

Posted: Wed Feb 17, 2016 7:46 pm
by mr.zatan
snasui wrote::D วิธีการที่ใช้นั้นเป็นการดึงภาพจาก Web มาแสดง กรณีที่ต้องการดึงภาพที่เก็บไว้ในเครื่องมาแสดง ดูตัวอย่างได้ที่นี่่ครับ wordpress/picture-from-folder/
แต่ติดตรงที่ต้องกดปุ่ม รูปถึงจะโชวนี่สิ ครับ
คือผมอยากให้ใส่ชื่อเสร็จ enter รูปขึ้นมาเลยน่ะครับ.

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

Posted: Wed Feb 17, 2016 7:51 pm
by snasui
:D อันนั้นไม่ใช่ปัญหา Code เดิมเป็นการเรียกใช้ Event

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

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

Posted: Thu Feb 18, 2016 11:02 am
by 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

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

Posted: Thu Feb 18, 2016 6:09 pm
by snasui
:D เอา Width:=r.Width, Height:=r.Height ออกหากไม่ต้องการปรับให้ความกว้างและความสูงภาพมีขนาดเท่าความกว้างและความสูงเซลล์ครับ

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

Posted: Thu Feb 18, 2016 6:17 pm
by 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

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

Posted: Thu Feb 18, 2016 9:32 pm
by snasui
:o ขออภัยครับ .AddPicture จำเป็นต้องกำหนดตำแหน่งและความสูงความกว้าง ไม่สามารถละไว้ได้ครับ

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

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

Posted: Thu Feb 18, 2016 10:50 pm
by 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

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

Posted: Thu Feb 18, 2016 11:33 pm
by snasui
mr.zatan wrote:สรุปคือ Width ไม่สามารถปรับเป็น Auto ได้ใช่มัยครับ
:D คำว่า "มัย" ที่ถูกต้องคือ "ไหม" หรือเขียนเป็น "หรือไม่" ครับ ส่วนคำตอบนั้นผมตอบไว้แล้วตามโพสต์ด้านบน

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

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