Excel Forum

Code: Select all

Sub ShowPicture00()
    Dim r As String
    r = Range("B9").Value
    On Error Resume Next
    ActiveSheet.Shapes(1).Delete
    Range("H2").Select
    ActiveSheet.Pictures.Insert("D:\PicSSK\" & r & ".BMP").Select
    Selection.ShapeRange.ScaleWidth 0.14, _
        msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.14, _
        msoFalse, msoScaleFromTopLeft
    Range("B9").Select
End Sub
Sub ShowPicture()
Dim r As String
Dim imgIcon
On Error Resume Next
    ActiveSheet.Shapes(1).Delete
r = Range("B9").Value
With Range("H2")
    Set imgIcon = ActiveSheet.Shapes.AddPicture( _
    Filename:="D:\PicSSK\" & r & ".BMP", LinkToFile:=False, _
    SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
    Width:=120, Height:=130)
End With
Set imgIcon = Nothing
End Sub

Code: Select all

Sub ShowPicture()
    Dim r As String
    Dim p As Object
    Dim imgIcon
    On Error Resume Next
    For Each p In ActiveSheet.Shapes
        If p.Name <> "รูปภาพ 5" Then
            p.Delete
        End If
    Next p
'     ActiveSheet.Shapes(1).Delete
    r = Range("B9").Value
    With Range("H2")
        Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:="D:\PicSSK\" & r & ".BMP", LinkToFile:=False, _
        SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
        Width:=120, Height:=130)
    End With
    Set imgIcon = Nothing
End Sub

Code: Select all

For Each p In ActiveSheet.Shapes
        If p.Name <> "รูปภาพ 5" Then
           p.Delete
        End If
 Next p

Code: Select all

For Each p In ActiveSheet.DrawingObjects
        If p.Name <> "รูปภาพ 5" Then
            p.Delete
        End If
    Next p