[求助]excel如何引用图片(最好能把图片固定到单元格

好为人师

excel如何引用图片，（最好能把图片固定到单元格，再用函数引用），例如A1输入1，B1就出现图片1，A1输入2，B1就出现图片2，以此类推

snood

论坛里有这样的例子，搜一下。

FYBOX

 if [a1]=1 then

    Sheet1.Shapes("图片 1").Visible =  msoTrue 

ElseIf [a1]=2 then

    Sheet1.Shapes("图片 2").Visible =  msoTrue

end if                            

如果有几十张，那就用循环

好为人师

楼上的VB怎样使用，我放到excel的VB里，好像不能用

FYBOX

 Sheet1.Shapes("图片 1").Visible =  msoTrue 

代码解释：

Sheet1：图片所在的工作表

"图片 1"：图片名称，在编辑栏栏左侧可以看到这个名称

.Visible =  msoTrue ：显示

.Visible =  msoFalse ：隐藏

再搞不定，请传上附件

[此贴子已经被作者于2006-11-1 8:42:16编辑过]

好为人师

回楼上，这是附件 0mQ7uCtX.rar (107.68 KB, 下载次数: 519)

2006-11-1 10:27 上传

点击文件名下载附件
[求助]excel如何引用图片(最好能把图片固定到单元格

[此贴子已经被作者于2006-11-1 10:28:03编辑过]

FYBOX

好为人师：首先，你要学礼貌，其次才学程序！而且名字有点狂！

提示：你的要求可以按照下面的思路：

1.响应单元格改变来启动代码

2.用循环来判断

3.显示对应的图片，隐藏其他图片

4.调整图片的对应位置

好为人师

呵呵，楼上好大脾气，名字是随便起的，因为我试了几个名字，都有人注册了，这个刚好没有。我不会VB，函数还行，研究过一段时间，excel在单位还可以，但在这里就是很菜了。这两天搞交通工程，要插入大量图片，比较急，弄这个弄了两天，总是不妥，以前工作中都没有难倒的，所以心情着急些，平时我是很有礼貌的哦，呵呵，刚才蒙山菊花版主指点，给了一份代码，现共享，看是否还能完善，再次感谢论坛热心朋友，小程序解决了大问题。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Columns.Count > 1 Then Exit Sub
    If Target.Column > 1 Then Exit Sub
    Dim Rng As Range
    For Each Rng In Target
        If IsNumeric(Rng) Then
            With Range("i" & Int(Rng))
                .Copy Rng.Offset(0, 1)
                If Rng.RowHeight < .RowHeight Then
                    Rng.RowHeight = .RowHeight
                End If
            End With
        End If
    Next
End Sub

小小遗憾：显示图片的列（B）能不能先清除B列单元格图片，再复制对应图片，否则A列更改图片编号后，B列对应图片会覆盖在已有图片上，变成两张.  另外，如果我再同时在C列输入图片编号，D列显示相应图片，不知道要怎么改？

[此贴子已经被作者于2006-11-1 18:06:02编辑过]

好为人师

我已经修改好了，可以在实现我上面（8楼）的功能，现共享

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Dim objDraw As Object

With Target
    If .Columns.Count > 1 Then Exit Sub
    If .Column = 1 Or .Column = 3 Then
        Set Rng = Columns(8).Find(.Value, lookat:=xlWhole, MatchCase:=True)
        If Not Rng Is Nothing Then
            For Each objDraw In ActiveSheet.DrawingObjects
                If .Offset(0, 1).Address = objDraw.TopLeftCell.Address Then
                    objDraw.Delete
                End If
            Next
            Rng.Offset(0, 1).Copy .Offset(0, 1)
            If .RowHeight < Rng.RowHeight Or .ColumnWidth < Rng.ColumnWidth Then
                .RowHeight = Rng.RowHeight
                .Offset(0, 1).ColumnWidth = Rng.ColumnWidth
            End If
        End If
    End If
End With
End Sub

qwertyuioppp

请上传一个做好的,学习一下,好吗?[em10]