EXCEL2007 图片批量插入，单击图片改变大小

今又

希望大神帮助一下，看了好多帖子，都无解，谢谢！

今又

顶一顶

wp8680

Sub tt()
    Dim rg As Range, rgs As Range, shap As Shape
    Dim pat$
    On Error Resume Next
    Set rgs = Application.InputBox("拉选序号所在的区域，并且本文件所在的文件夹中存在同序号的图片！", "如有疑问QQ399457850", "$A$5:$A$17", , , , , 8)
    pat = ThisWorkbook.Path & "\"
    For Each shap In ActiveSheet.Shapes
        shap.Delete
    Next shap
    For Each rg In rgs
        If rg <> "" Then
        Err.Clear
            rg.Offset(0, 8).Select
            With ActiveSheet.Pictures.Insert(pat & rg.Value & ".jpg")
                If Err.Number = 0 Then
                .ShapeRange.LockAspectRatio = msoFalse
                    .ShapeRange.Width = rg.Offset(0, 8).Width
                    .ShapeRange.Height = rg.Offset(0, 8).Resize(3, 1).Height
'                    .OnAction = "FDSX"
                End If
            End With
        End If
    Next rg
   
End Sub

爱疯

插入图片并通过单击改变图片大小.rar (64.42 KB, 下载次数: 102)

2015-8-3 20:18 上传

点击文件名下载附件



'插入图片
Sub test1()
    Dim A(1 To 3), i%, j%, p$

    ActiveSheet.Pictures.Delete
    A(1) = 4    ' InputBox("开始行号:")
    A(2) = 14    'InputBox("结束行号:")
    A(3) = 5    'InputBox("间隔行数:")
    p = ThisWorkbook.Path & "\"

    For i = A(1) To A(2) Step A(3)
        j = j + 1
        With Cells(i, "I")
            ActiveSheet.Shapes.AddPicture Filename:=p & j & ".jpg", LinkToFile:=msoTrue, SaveWithDocument:=msoTrue, _
                                          Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Resize(4).Height
        End With
    Next i
    Call test2
End Sub

'设置单击指定对象时运行的宏的名称
Sub test2()
    Dim x
    For Each x In ActiveSheet.Shapes
        If x.Type = 11 Then x.OnAction = "test3"
    Next
End Sub

'单击图片所执行的事情
Sub test3()
    With ActiveSheet.Shapes(Application.Caller)
        .ZOrder msoBringToFront
        If .Width - 1 > Range("i:i").Width Then
            .Width = .Width / 2: .Height = .Height / 2
        Else
            .Width = .Width * 2: .Height = .Height * 2
        End If
    End With
End Sub



这样可以吗？
蓝色部分的代码，请自行修改。

学良

    请老师给发个03版的.
    谢谢!

爱疯

学良 发表于 2015-8-4 08:56
请老师给发个03版的.
    谢谢!

插入图片并通过单击改变图片大小2.rar (72.92 KB, 下载次数: 65)

2015-8-4 09:14 上传

点击文件名下载附件



稍改了下，另存了一个03版的。

爱疯

发现一个怪现象，只在03版中有，

单击图片时，按住左键，图片会变得像照片底片一样。松开左键，则恢复正常。

今又

非常感谢版主老师，现在在使用过程中出现问题
如果号码是不连续的，如1.2.3.5.8.9.10.11.12.13图片对应的库是1.2.3.4.8.9.没有的，能否设置不添加图片，应该怎么更改呢

爱疯

插入图片并通过单击改变图片大小3.rar (583.78 KB, 下载次数: 73)

2015-8-4 11:11 上传

点击文件名下载附件

今又

老师，我的意思是序号是不连续的，但是序号与图片是一一对应的，不是行号，比如8号就是张柏芝，是固定不变的，我们想做一个产品名录，每个产品都有对应的编码，筛选编码，那么对应的产品就可以出来。不知道说明白了么，谢谢啦