EXCEL中VBA问题

[usher_gml]

如何在EXCEL中动态的显示图片,要求如下:
1,在某一CELL中输入图片的绝对路径,移开焦点后,在该cell的右边自动显示图片,并且图片可根据列的大小自动适应.
2,当修改路径完后,该CELL右边的图片会被删除并替换上新的图片.
请高手帮忙!!
请问EXCEL能做到吗??


之前在论坛中找到一个类似问题答案..由于本人不懂VBA...
帮忙看看...
可以参考这个:http://topic.csdn.net/t/20030721/17/2054348.html

[zhiyongtu]

[Quote=引用楼主 usher_gml 的帖子:]
1,在某一CELL中输入图片的绝对路径,移开焦点后,在该cell的右边自动显示图片,并且图片可根据列的大小自动适应.
2,当修改路径完后,该CELL右边的图片会被删除并替换上新的图片.
[/Quote]
这里说的CELL是固定的吗？还是随便在哪个CELL中输入后都要实现这种效果？

[usher_gml]

自己顶一下..都没人气..

[usher_gml]

[Quote=引用 1 楼 zhiyongtu 的回复:]
引用楼主 usher_gml 的帖子:
1,在某一CELL中输入图片的绝对路径,移开焦点后,在该cell的右边自动显示图片,并且图片可根据列的大小自动适应.
2,当修改路径完后,该CELL右边的图片会被删除并替换上新的图片.


这里说的CELL是固定的吗？还是随便在哪个CELL中输入后都要实现这种效果？
[/Quote]

不固定..随便那个CELL都可以得到的效果

[usher_gml]

达人们都很忙呢..自己UP一下..

[zhiyongtu]

Option Explicit

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

在VBA环境中，将以上代码粘贴进你所需要的工作表模块，如sheet1、sheet2之类。

[usher_gml]

[Quote=引用 5 楼 zhiyongtu 的回复:]
VB codeOption Explicit

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.O…
[/Quote]]

非常感谢...完全符合要求..