V-LookUp + VBA ดึงรูป

[sup]

สวัสดีครับอาจารย์ และกูรูทุกท่านครับ

ก็มีเรื่องมารบกวนอีกแล้วครับ พยายามศึกษาอยู่หลายวัน ก็ยังไม่ค่อยเข้าใจเท่าไร เลยต้องเข้ามาขอความช่วยเหลือครับ
ผมได้สร้างไฟล์ Excel ที่ใช้ V-LookUp ดึงข้อมูลมาแสดง ใน Sheet1 โดยใส่รหัสที่ O1 และในส่วนของข้อมูลที่ดึงมาจะมีรหัสรูปแสดง ก็ให้ดึงรูปจากโฟลเดอร์ Pic ที่เก็บที่ไดร์ฟ D มาโชว์ ครั้งละหลายๆรูป(มากสุด 50 รูป) ผมเอา Code จากที่ได้มาจาก Forum นี้หละครับมาปรับปรุง ปรากฎว่าติดปัญหาบางส่วน เลยต้องขอความช่วยเหลือดังนี้ครับ
1. ต้องคลิ๊ก Run ทุกครั้งเพื่อให้รูปถูกดึงมาโชว์ อยากให้เมื่อเรา Enter ที่ O1 แล้ว พอข้อมูลถูกดึงมา รูปก็ถูกดึงมาด้วยทันทีครับ ตามรหัสที่แสดง
2. เมื่อเปลี่ยนรหัสที่ O1 รูปใหม่ถูกดึงมา(ต้องคลิ๊ก Runเหมือนเดิม) แต่ซ้อนทับรูปเก่า อยากให้รูปเก่าถูกลบไปก่อนครับ แล้วรูปใหม่ก็ถูกดึงมาโชว์ ผมแก้ไข Code หลายวิธีแล้วครับก็ยังไม่สำเร็จ เลยไม่แน่ใจว่าถูกหรือไม่
3. กรณีที่ไม่มีรูปตามรหัสที่ปรากฎอยากให้แสดงเป็นข้อความในส่วนที่โชว์รูปครับว่า "ไม่พบรูปที่เรียก"

ผมได้แนบไฟล์ทดสอบ และไฟล์รูปมาครับ Code จะอยู่ใน Module1 และ Sheet1 ครับ

ต้องรบกวนขอคำชี้แนะด้วยครับ

ขอบคุณล่วงหน้าครับ

ช่วงนี้ฝนตกบ่อย ขอให้ทุกท่านสุขภาพแข็งแรงครับ

[sup]

พยายามส่งรูปอยู่ครับ

[snasui]

ที่ Link นี้มี Code สำหรับการลบรูปเก่าทิ้งไปอยู่ด้วยครับ http://snasui.blogspot.com/2011/05/folder-excel.html กรณีที่้ต้องการให้เปลียน O1 แล้ว Code ทำงาน ใน Sheet1 ปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$O$1" Then
        Call ShowPicture
    End If
End Sub

[sup]

ขอบคุณครับอาจารย์ ทดลองดึงได้ตามต้องการแล้วครับ ส่วนการลบ ต้องขอแกะ Code ก่อนครับ คืบหน้าอย่างไรจะมาแจ้งผลที่หลังครับ

อย่าลืมทานอาหารกลางวันด้วยครับ ของผม เป็นส้มตำกับครอบครัวครับ ภรรยาจัดให้

[sup]

ใช้เวลามาค่อนวันนี้ ยังไม่สำเร็จครับอาจารย์ Code ตามข้างล่างนี้หากให้แสดงแค่รูปเดียวก็สามารถลบรูปเก่าออกก่อนได้ แต่เมื่อทำหลายรูปกลับทำไม่ได้ ก็เลยมึนครับ อาจารย์ช่วยแนะนำที่ครับ (ศึกษาตามLink ที่อาจารย์ให้มาหลายรอบแล้วก็ยังมึนครับ)

Code: Select all

Sub ShowPicture()
Dim r As String
Dim imgIcon
On Error Resume Next
    ActiveSheet.Shapes(1).Delete 'ลบรูปเก่า
r = Range("F4").Value
With Range("G4")
    Set imgIcon = ActiveSheet.Shapes.AddPicture( _
    Filename:="D:\Pic\" & r & ".jpg", LinkToFile:=False, _
    SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
    Width:=180, Height:=138)
End With
Set imgIcon = Nothing
End Sub

ขอบคุณล่วงหน้าครับ

[snasui]

Code สำหรับลบรูปคือด้านล่างครับ

Code: Select all

'...    
Dim obj As Object
For Each obj In ActiveSheet.Shapes
    If Left(obj.Name, 4) = "Pict" Then
        obj.Delete
    End If
Next obj
'....

[sup]

สวัสดีครับอาจารย์

ขอขอบคุณมากๆครับ ผมก็งมอยู่ตั้งนานเพราะคิดว่า Code ที่ใช้ลบมีเพียงแถวเดียว ที่ไหนได้เป็นชุด เลยทำให้ไม่สำเร็จ ผมใช้ Code ที่อาจารย์ให้มาแล้วก็ OK เลยครับ

แต่สงสัยว่าระหว่าง Code เก่าที่ใช้กับภาพเดียว กับ Code ชุดนี้แตกต่างกันอย่างไรครับ รบกวนอธิบายด้วยครับ เพราะเห็นมี If Left (obj.name,4) = "Pict" Then อยู่ด้วย ซึ่งเท่ากับให้ลบ object ทีมีชื่อ pict นำหน้าออก แต่ของผมไม่มี Pict ผลเลยไม่ได้หยิบมาใช้ด้วย ไม่ทราบว่าผมเข้าใจถูกต้องไหมครับ ต้องขอความกระจ่างครับ

ขอบคุณอีกครั้งครับ

[snasui]

Code นี้เป็นการ loop เพื่อลบทุก Object ที่มีชื่อนำหน้าว่า Pict ออกไปครับ สังเกต For Each...Next

[sup]

เริ่มพอเข้าใจแล้วครับอาจารย์ ที่นี้ในกรณีที่หากไม่มีรูป ให้กราปฎข้อความ "ไม่มีรูปตามที่เรียก" จะใส่ Code ช่วงใดครับ

[snasui]

ตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

'...
r = Range("I5").Text   'ตำแหน่งใส่ชื่อเรียกมา
If IsError(Range("I5")) Then
    MsgBox "Not found picture"
Else
    With Range("J5")  ' ตำแหน่งที่แสดงรูป
        Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:="D:\Pic\" & r & ".jpg", LinkToFile:=False, _
        SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
        Width:=180, Height:=138) 'กำหนดให้เริ่มจากซ้าย-บน และกำหนดขนาดกว้าง*สูงของรูปตำแหน่งการเก็บรูปที่ไดร์ฟ D :\ไฟล์ Pic\
    End With
End If
'....

[sup]

ขอบคุณครับอาจารย์

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

อาจารย์อย่าลืมทานอาหารกลางวันด้วยนะครับ

[sup]

สวัสดีครับอาจารย์
สรุปผลล่าสุดโค๊ตที่ใส่ให้บอกเมื่อไม่พบภาพตามรหัสที่เรียก ปรากฎว่าจะแสดง MsgBoxเยอะแยะไม่หมดเลยครับหากรูปหลายรูป ผมลองปรับโค๊ตดูแล้วก็ยังไม่เป็นผลครับ รบกวนอาจารย์อีกครั้งครับ อยากให้ออกมา ตามตัวอย่างในไฟล์แนบที่ผมใช้สูตรไว้ครับ คือแสดงข้อความใน Cell ที่วางภาพเลย หากรหัสนั้นไม่มีภาพอยู่ และหากไม่มีรหัสนั้น(ว่าง)ก็แสดงว่า "ว่าง" เลยครับ
อีกคำถามครับ ปกติเราสามารถเขียนโค๊ตให้ไปิดไฟล์ Excel ด้วยกันได้ แต่ในกรณีที่ต้องการให้เปิด PDF หรือ Word โดยมีปุ่ม CommandButton ให้คลิ๊ก จะทำได้ไหมครับ ต้องเขียนอย่างไรครับ

ต้องขอโทษครับที่รบกวนอีกครั้งหนึ่ง

[snasui]

ให้เปลี่ยนสูตรเป็น เช่นตามด้านล่างครับ

=IF(ISNA(I5),"ไม่พบภาพตามรหัสที่เรียก","ว่าง")

Enter > Copy ไปยังเซลล์อื่น ๆ ที่เกี่ยวข้อง

ถ้าต้องการใช้ VBA ให้ปรับ Code มาเองก่อน แล้วนำ Code ที่ปรับแล้วมาและยังติดปัญหามาถามกันครับ

[deeperice]

ขออนุญาติครับ
ผมประสบปัญหาคล้ายๆ กับเจ้าของกระทู้นี้ครับ เเต่เปลี่ยนจากการหารูปเป็นไฟล์ PDF ครับ

[snasui]

กรณีใช้ VBA ให้เขียนมาเองก่อน ติดตรงไหนแล้วค่อยถามกันต่อ อ่านกฎการใช้บอร์ดด้านบน ข้อ 4 เรื่องการแนบไฟล์ ข้อ 5 เรื่องการโพสต์ Code ให้แสดงเป็น Code เพื่อสะดวกต่อการอ่านและการคัดลอกไปทดสอบด้วยครับ