根据地址显示图片

 如何可以删除指定单元格里的图片

Sub 删除()

dim x as Integer
 For x = 1 To Sheet1.Shapes.Count
   If Sheet1.Shapes(x).TopLeftCell.Address = "$A$1" Then
     Sheet1.Shapes(x).Delete
   End If
 Next x
End Sub

如果有多个图片：

Sub 删除()

dim x as Integer
 For x = Sheet1.Shapes.Count To 1 step -1
   If Sheet1.Shapes(x).TopLeftCell.Address = "$A$1" Then
     Sheet1.Shapes(x).Delete
   End If
 Next x
End Sub

如何在EXCEL中动态的显示图片,要求如下:  
  1.在某一CELL中输入图片的绝对路径,移开焦点后,在该cell中自动显示图片,并且图片可根据列的大小自动适应.  
  请高手帮忙!!  
  请问EXCEL能做到吗??

  Private   Sub   Worksheet_Change(ByVal   Target   As   Range)  
  Dim   a   As   Shape,   r   As   Single  
          If   Dir(Target.Text)   <>   ""   Then  
                ActiveSheet.Pictures.Insert(Target.Text).Select  
                Selection.ShapeRange.Top   =   Target.Top  
                Selection.ShapeRange.Left   =   Target.Left  
                r   =   Target.Width   /   Selection.ShapeRange.Width  
                Selection.ShapeRange.ScaleWidth   r,   msoFalse,   msoScaleFromTopLeft  
                Selection.ShapeRange.ScaleHeight   r,   msoFalse,   msoScaleFromTopLeft  
                Rows(Target.Row).RowHeight   =   Selection.ShapeRange.Height  
                Selection.Placement   =   xlMoveAndSize  
                Selection.PrintObject   =   True  
                Target.Select  
          End   If  
  End   Sub  

最佳效果CODE:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Len(Target.Text) = 0 Then Exit Sub
    Dim sngLeft As Single, sngTop As Single, sngRight As Single, sngBottom As Single, sngScale As Single
    Dim rngCell As Range, rngCellBR As Range, shp As Shape, tmp
    If Dir(Target.Text) <> "" Then
        Set rngCell = Target.Offset(0, 1)
        Set rngCellBR = rngCell.Offset(1, 1)
        sngTop = rngCell.Top
        sngLeft = rngCell.Left
        sngRight = rngCellBR.Left
        sngBottom = rngCellBR.Top
        For Each shp In ActiveSheet.Shapes
            If shp.Top >= sngTop - 5 And shp.Top < sngBottom - 5 And shp.Left >= sngLeft - 5 And shp.Left < sngRight - 5 Then
                shp.Delete
                Exit For
            End If
        Next shp
        rngCell.Select
        On Error GoTo ErrorHandler
        ActiveSheet.Pictures.Insert(Target.Text).Select
        Set shp = Selection.ShapeRange(1)
        shp.Top = rngCell.Top
        shp.Left = rngCell.Left
        sngScale = rngCell.Width / shp.Width
        shp.ScaleWidth sngScale, msoFalse, msoScaleFromTopLeft
        shp.ScaleHeight sngScale, msoFalse, msoScaleFromTopLeft
        rngCell.Rows.RowHeight = shp.Height
        shp.Placement = xlMoveAndSize
ErrorHandler:
        Set shp = Nothing
        Set rngCell = Nothing
        Set rngCellBR = Nothing
        Set Target = Nothing
    End If
End Sub

找出某目录下所有文件的名称:

Private Sub Workbook_Open()
f = Dir("T:/xyz/*")
Do While f <> ""
r = r + 1
Cells(r, 1) = f
f = Dir
Loop
End Sub