Page 1 of 1

การดึงรูปจาก Folder มาลงใน Excel โดยมีเงื่อนไขให้ค้นหาจาก 2 Folder

Posted: Mon Apr 03, 2023 5:53 pm
by Teeranai
อาจารย์ครับถ้าเราต้องการดึงรูปจาก Folder มาลงใน Excel โดยมีเงื่อนไขให้ค้นหาจาก 2 Folder จะสามารถทำได้ไหมครับและถ้าได้ ขอความอนุเคราะห์สูตรที่เขียนในไฟล์ Excel แล้วนำมาแก้ไขชื่อโฟล์เดอร์ที่ต้องการเรียกรูปได้ไหม

Re: การดึงรูปจาก Folder มาลงใน Excel โดยมีเงื่อนไขให้ค้นหาจาก 2 Folder

Posted: Mon Apr 03, 2023 5:54 pm
by snasui
:D ต้องใช้ VBA ในการทำงานเช่านนั้น ต้องเขียนมาเองก่อนตามกฎการใช้บอร์ดข้อ 5 ด้านบน :roll: ติดตรงไหนค่อยถามกันต่อครับ

Re: การดึงรูปจาก Folder มาลงใน Excel โดยมีเงื่อนไขให้ค้นหาจาก 2 Folder

Posted: Mon Apr 03, 2023 6:34 pm
by Teeranai
Private Sub CommandButton1_Click()
Dim r, ra, rb As Range
Dim imgIcon, obj As Object
Dim PicFile As String
On Error Resume Next
With Worksheets("Sheet1")
Set ra = .Range("B2:B" & .Range("c1500").End(xlUp).Row)
Set rb = .Range("N2:N" & .Range("o1500").End(xlUp).Row)
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 Union(ra, rb)
PicFile = "X:\016_Front End1 Team1\02_Control\Controller BB\1_Data Center_FN shop floor control\ItemsPic\" & r.Offset(0, 1) & ".jpg"
If Dir(PicFile) <> vbNullString Then
Set imgIcon = ActiveSheet.Shapes.AddPicture( _
Filename:=PicFile, LinkToFile:=False, _
SaveWithDocument:=True, Left:=r.Left + 1, Top:=r.Top, _
Width:=r.Width - 1, Height:=r.Height)
End If
Next r
End Sub
ประมาณนี้ครับแต่สามารถค้นหาได้แค่ Folder เดียวครับ ไม่สามารถค้นหา Folder ที่ 2 ได้ครับ

Re: การดึงรูปจาก Folder มาลงใน Excel โดยมีเงื่อนไขให้ค้นหาจาก 2 Folder

Posted: Mon Apr 03, 2023 6:47 pm
by snasui
:D การโพสต์ Code กรุณาครอบด้วย Tag Code ดูกฎข้อ 5 ด้านบน :roll: นอกจากนี้กรุณาแนบไฟล์ Excel พร้อม Code นี้มาด้วยจะได้ดูต่อไปจากนั้นครับ