Excel Forum

Code: Select all

Sub ShowPicture()
Dim r As String
Dim imgIcon
On Error Resume Next
    ActiveSheet.Shapes(1).Delete
r = Range("AA1").Value
With Range("Q17,Q46,Q75,Q104,Q133,Q162,Q191,Q220,Q249,Q278")
    Set imgIcon = ActiveSheet.Shapes.AddPicture( _
    Filename:="D:\1.pic\" & r & ".jpg", LinkToFile:=False, _
    SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
    Width:=344, Height:=253)
End With
Set imgIcon = Nothing
End Sub

Code: Select all

On Error Resume Next
For Each shp In ActiveSheet.Shapes
    If Left(shp.Name, 3) = "Pic" Then
        shp.Delete
    End If
Next shp
r = Range("AA1").Value
For Each Rng In Range("Q17,Q46,Q75,Q104,Q133,Q162,Q191,Q220,Q249,Q278")
    With Rng
        Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:="D:\1.pic\" & r & ".jpg", LinkToFile:=False, _
        SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
        Width:=344, Height:=253)
    End With
Next Rng
Set imgIcon = Nothing

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$AA$1" Then
    Call ShowPicture
End If
Application.EnableEvents = True
End Sub

Code: Select all

Dim r As String
Dim imgIcon
On Error Resume Next
For Each shp In ActiveSheet.Shapes
    If Left(shp.Name, 3) = "pic" Or Left(shp.Name, 3) = "รูป" Then
        shp.Delete
    End If
Next shp
r = Range("AA1").Value
For Each Rng In Range("Q17,Q46,Q75,Q104,Q133,Q162,Q191,Q220,Q249,Q278")
    With Rng
        Set imgIcon = ActiveSheet.Shapes.AddPicture( _
        Filename:="D:\1.pic\" & r & ".jpg", LinkToFile:=False, _
        SaveWithDocument:=True, Left:=.Left, Top:=.Top, _
        Width:=342, Height:=251)
    End With
Next Rng
Set imgIcon = Nothing