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

ตามที่อธิบายมา
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

แนบไฟล์พร้อมรูปที่จะให้แสดงมาด้วยจะได้ช่วยทดสอบได้ครับ
Re: VBA ดึงรูปแล้วเกิด error
Posted: Wed Feb 17, 2016 5:23 pm
by mr.zatan
ตามไฟล์รูปและไฟล์แนบครับ

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
ไฟล์พร้อมรูปครับ

Re: VBA ดึงรูปแล้วเกิด error
Posted: Wed Feb 17, 2016 7:12 pm
by snasui

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

อันนั้นไม่ใช่ปัญหา 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

เอา
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

ขออภัยครับ
.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 ได้ใช่มัยครับ

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

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

ทั้ง ๆ ที่ Code นี้สามารถได้มาด้วยการบันทึก Macro