อยากให้ แสดงรูป ตามชื่อที่กำหนดได้มัยครับ....

[Nunging]

อยากให้รูปแสดงในช่องที่กำหนด โดยใช้ INDEX & MATCH แล้วรูปไม่ขึ้น ไม่ทราบว่าต้องใช้สูตรอะไรคะ รบกวนด้วยค่ะ

[tupthai]

ช่วยแนบไฟล์มาด้วยครับ จะได้ทดสอบได้

[tupthai]

ต้องการช่องของตัวนี้ตรงกับช่อง A แล้ว แล้วช่อง Pic.code ให้ขึ้นค่าของช่อง B ตัวนี้เราต้องใช้สูตรอะไรคะ ลองใช้ INDEX & MATCH แล้วรูปไม่ขึ้น

ช่อง A ควรบอกว่า คอลัมน์ A หรือระบุเซลล์ไปเลยว่าจาก A1 ถึง A3 จะได้เข้าใจตรงกันครับ
ขอถามครับ
ช่องของตัวนี้ คือ D9 ใช่หรือไม่ แล้วต้องการให้รูปอยู่ที่เซลล์ไหนครับ

[joo]

ลองแบบนี้ดูครับว่าตรงกับที่ต้องการไหมให้ทำการกำหนด Range Name แบบนี้
1. Sym ='Pic Table'!$B$3:$B$5
2. Model ='Pic Table'!$A$3:$A$5
3. PicShow =INDEX(Sym.Pic,MATCH('Pic Table'!$D$9,Model,0))
4. Copy รูปมาวางไว้ที่ L8 แล้วพิมพ์ = PicShow
ลองดูตามไฟล์แนบครับ

[xxyz]

thank you.

[Anurakp]

รบกวนดูโค้ดให้ทีครับ

[snasui]

รบกวนดูโค้ดให้ทีครับ

ช่วยเขียนอธิบายปัญหามาด้วย อ่านกฎข้อ 5 ด้านบนประกอบครับ

[raweeroge]

ขออนุญาตถามต่อกระทู้นี้นะครับ คือ บริเวณสีนำ้เงินคอลัมภ์ G สามารถดึงภาพมาแสดงได้แล้วโดยอ้างอิงจากคอลัมภ์ F ถ้าผมอยากให้ดึงรูปมาแสดงเพิ่มในคอลัมภ์ K โดยอ้างอิงจากคอลัมภ์ J ไม่ทราบว่าจะต้องแก้ไขหรือเพิ่มเติม CODE อย่างไรครับ

CODE: SELECT ALL
Sub ShowPicture()
Dim r As Range, ra As Range
Dim imgIcon As Object
Dim obj As Object
On Error Resume Next
With Worksheets("Sheet1")
Set ra = .Range("G4", .Range("F65536").End(xlUp).Offset(0, 1))
End With
For Each obj In ActiveSheet.Shapes
If Left(obj.Name, 4) = "Pict" Then
obj.Delete
End If
Next obj
For Each r In ra
Set imgIcon = ActiveSheet.Shapes.AddPicture( _
Filename:="D:\Test the end year party card\" & r.Offset(0, -1).Value & ".bmp", LinkToFile:=False, _
SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
Width:=r.Width, Height:=r.Height)
Next r
End Sub

[snasui]

โพสต์ Code ให้เป็นไปตามกฏข้อ 5 ด้านบนด้วยครับ

[pongpang]

เรียน อาจารย์ และ สมาชิก ทุกท่าน
ขอความกระจ่างเพิ่มเติมครับ จาก Code

Code: Select all

Sub ShowPicture()
Dim r As Range, ra As Range
Dim imgIcon As Object
Dim obj As Object
On Error Resume Next
With Worksheets("Sheet1")
    Set ra = .Range("G4", .Range("F65536").End(xlUp).Offset(0, 1))
 End With
 For Each obj In ActiveSheet.Shapes
    If Left(obj.Name, 4) = "Pict" Then
        obj.Delete
    End If
Next obj
For Each r In ra
    Set imgIcon = ActiveSheet.Shapes.AddPicture( _
    Filename:="D:\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
    SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
    Width:=r.Width, Height:=r.Height)
Next r
End Sub

จะพบว่า ภาพที่วางในเซล จะเป็นการวางซ้อนเพิ่มตลอด จะต้องปรับปรุง Code อย่างไรครับ ให้วางภาพเพียงภาพเดียว โดยไม่วางภาพซ้อนกันครับ

[bank9597]

แก้จาก Filename:="D:\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False
เป็น Filename:="D:\" & r.Offset(1, -1).Value & ".jpg", LinkToFile:=False

[snasui]

จะพบว่า ภาพที่วางในเซล จะเป็นการวางซ้อนเพิ่มตลอด จะต้องปรับปรุง Code อย่างไรครับ ให้วางภาพเพียงภาพเดียว โดยไม่วางภาพซ้อนกันครับ

Code นั้นเป็นการลบภาพเดิมทิ้งไปก่อนแล้วค่อยนำภาพจาก Path ที่กำหนดไว้มาแสดง ไม่ควรที่จะมีการเพิ่มภาพเข้ามาเรื่อย ๆ ลองแนบไฟล์พร้อมตัวอย่างและตำแหน่งภาพมาดูกันครับ

[pongpang]

เรียน อาจารย์ ครับ

จะพบว่า ภาพที่วางในเซล จะเป็นการวางซ้อนเพิ่มตลอด จะต้องปรับปรุง Code อย่างไรครับ ให้วางภาพเพียงภาพเดียว โดยไม่วางภาพซ้อนกันครับ

Code นั้นเป็นการลบภาพเดิมทิ้งไปก่อนแล้วค่อยนำภาพจาก Path ที่กำหนดไว้มาแสดง ไม่ควรที่จะมีการเพิ่มภาพเข้ามาเรื่อย ๆ ลองแนบไฟล์พร้อมตัวอย่างและตำแหน่งภาพมาดูกันครับ

insertpic.xlsm

[snasui]

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

Code: Select all

Sub ShowPicture()
    Dim r As Range, ra As Range
    Dim imgIcon As Object
    Dim obj As Object
    On Error Resume Next
    With Worksheets("Sheet1")
        Set ra = .Range("G4", .Range("F65536").End(xlUp).Offset(0, 1))
     End With
     For Each obj In ActiveSheet.Shapes
        If Left(obj.Name, 4) = "Pict" Or Left(obj.Name, 3) = "รูป" Then
            obj.Delete
        End If
    Next obj
    For Each r In ra
        Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:="C:\Users\com\Pictures\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
        SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
        Width:=r.Width, Height:=r.Height)
    Next r
End Sub

[pongpang]

เรียน อาจารย์ ครับ

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

Code: Select all

Sub ShowPicture()
    Dim r As Range, ra As Range
    Dim imgIcon As Object
    Dim obj As Object
    On Error Resume Next
    With Worksheets("Sheet1")
        Set ra = .Range("G4", .Range("F65536").End(xlUp).Offset(0, 1))
     End With
     For Each obj In ActiveSheet.Shapes
        If Left(obj.Name, 4) = "Pict" Or Left(obj.Name, 3) = "รูป" Then
            obj.Delete
        End If
    Next obj
    For Each r In ra
        Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:="C:\Users\com\Pictures\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
        SaveWithDocument:=True, Left:=r.Left, Top:=r.Top, _
        Width:=r.Width, Height:=r.Height)
    Next r
End Sub

insertpic.xlsm

ผลยังคงเหมือนเดิมครับ คือ ภาพที่ได้ใหม่จะทับภาพเก่าซ้อนกันอยู่ 2 ภาพ ครับ ตามไฟล์ที่แนบครับ

[snasui]

ในเครื่องผมสามารถลบภาพเก่าออกได้ตามปกติ ให้ Mark On Error Resume Next ให้เป็น Comment ไปก่อน แล้ว Run ทีละ Step สังเกตว่า Error ตรงบรรทัดใดครับ

[pongpang]

เรียน อาจารย์
ไม่มีบรรทัดใด ERROR ครับ ผมได้ลองปรับปรุงแล้วอาจจะเป็นเพราะความบกพร่องของโปรแกรม ผมจะพยายามค้นหาแล้วจะแจ้งอีกครั้ง ครับ
ขอบคุณมากครับ ที่ช่วยเหลือ ครับ

[jakkrit8015]

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

[puriwutpokin]

แก้ส่วนนี้ครับ

Code: Select all

For Each r In ra
    Set imgIcon = ActiveSheet.Shapes.AddPicture( _
    Filename:="D:\1.Personel งานบุคคล\7.รูปพนักงาน\2020\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
    SaveWithDocument:=True, Left:=r.Left + 1, Top:=r.Top + 1, _
    Width:=r.Width + 30, Height:=r.Height + 75)
Next r

[jakkrit8015]

ใช้วิธีโดยการแก้ Code ให้รูปภาพขยายเท่ากับเซลล์ที่ต้องการ เป็นอันว่าโอเคครับ ได้ผลลัพธ์ที่ต้องการ
ขอบคุณ puriwutpokin มากครับ