Snasui Excel Forum

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: 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