การดึงรูปจากโฟลเดอร์

[sutham]

ผมลองใส่โค๊กตามที่อาจาร์ได้แนะนำไว้ในเว็บไซต์
แต่พอผมลองเพิ่มชื่อโฟลเดอร์เข้าไป ตรงตำแหน่ง Filename:="D:\" & r.Offset(0, -1).Value & ".jpg", LinkToFile:=False, _
แล้วลองรัน โค๊ด กลับใช้งานไม่ได้ครับ
ตัวอย่างโค๊ดของอาจารย์

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

[snasui]

ช่วยแนบไฟล์ตัวอย่างมาดูครับ ช่วยแจ้งด้วยว่าภาพอยู่ในโฟลเดอร์ไหน เพื่อน ๆ จะได้กันทดสอบได้ครับ

การโพสต์ Code ให้แสดงเป็น Code เพื่อความสะดวกในการคัดลอกไปทดสอบดูจาก Link นี้ครับ viewtopic.php?f=3&t=1187

[songsug]

ลองเอาไฟล์ที่ผมใช้งานไปแปลงเอานะครับ ตอนนี้ผมก็ใช้งานอยู่ ดึงรูปจาก Server มาใช้งาน เปลี่ยนที่อยู่ไฟล์รูปก็ใช้งานได้เลยคัรบ ส่วนรูปงานจริงผมขอลบออกบางส่วนนะครับ (หลังจากที่แทรกรูปหมดแล้วผมจะตั้ง shapes ไว้ชื่อว่า 1 นะครับ อันที่จริงผมไม่รู้จะตั้งว่าอะไรดี ที่ตั้งชื่อเป็นชื่อเดียวกัน เวลาลบ จะไ้ด้ลบง่ายๆครับ
การใช้งานมี 2 sheet ครับ หน้าแรกเอารหัสงานมาวางครับ เรียงต่อๆกันไปเลย ส่วนอีกหน้าจะนำรหัสงานคุณมาวางเพื่อดึงรูป แล้วก็มีปุ่ม Print แล้วก็ลบครับเอาไปปรับปรุงให้เหมาะกับการใช้งานนะครับ เอาของผมไว้เป็นแนวทางแล้วกันครับ

Code: Select all

Private Sub CommandButton1_Click()
On Error Resume Next
For i = 1 To 35
 ActiveSheet.Shapes("1").Delete
 Next i
End Sub

Private Sub CommandButton2_Click()
If [E1] = "" Then MsgBox "เลือกหน้าที่ต้องการ Print ": Exit Sub
On Error Resume Next
Dim Pho, Dir, Item As String
For j = 0 To Range("A2").Value - 1
          For i = 0 To 4
                    Dir = "M:\" ' อันนี้ที่คุณต้องเปลี่ยน
                    Item = Cells(10 + n, 1 + i)
                    If Item <> "" Then
                    Pho = Dir + Item + "U.jpg"
                    ActiveSheet.Shapes.AddShape(msoShapeRectangle, x1 + 2.25, x2 + 30#, 84#, 81.75).Select
                    Selection.ShapeRange.Fill.UserPicture _
                    Pho
                    Selection.ShapeRange.Line.ForeColor.SchemeColor = 99
                    Selection.Name = "1"
                    End If
                    x1 = x1 + 91
          Next i
                    x1 = 0
                    x2 = x2 + 105
                    n = n + 8
Next j
[a3].Select

End Sub

Private Sub CommandButton3_Click()
If [E1] = "" Then MsgBox "เลือกหน้าที่ต้องการ Print ": Exit Sub
On Error Resume Next
Dim Pho, Dir, Item As String
For j = 0 To Range("A2").Value - 1
          For i = 0 To 4
                    Dir = "P:\"
                    Item = Cells(10 + n, 1 + i)
                    If Item <> "" Then
                    Pho = Dir + Item + ".jpg"
                    ActiveSheet.Shapes.AddShape(msoShapeRectangle, x1 + 2.25, x2 + 30#, 84#, 81.75).Select
                    Selection.ShapeRange.Fill.UserPicture _
                    Pho
                    Selection.ShapeRange.Line.ForeColor.SchemeColor = 99
                    Selection.Name = "1"
                    End If
                    x1 = x1 + 91
          Next i
                    x1 = 0
                    x2 = x2 + 105
                    n = n + 8
Next j
[a3].Select
End Sub