怎么设置图片点击放大？？求大神啊！！！！急

angelloafer

就是让EXCEL中的图片点击之后会自动放大不变形！！！求各位大神！！！
就像图片上一样，点击一下图片就能放大，再点击一下就能缩小回去！！谢谢！！
就像举例2这个附件里面一样，点击就能放大，再点击就缩回原来大小！谢谢！

sub麻辣君

喏，直接把那个过程搬过来嘛

angelloafer

sub麻辣君 发表于 2019-10-28 16:26
喏，直接把那个过程搬过来嘛

你这个点击删除图片之后再加载图片    就没办法放大了

sub麻辣君

angelloafer 发表于 2019-11-1 11:48
你这个点击删除图片之后再加载图片    就没办法放大了

你把这一段子过程写进去，然后在你加载图片的过程最后调用一下这个子过程
Private Sub SetOnClick()
    Dim x
    For Each x In ActiveSheet.Shapes
        If x.Type = msoLinkedPicture Then x.OnAction = "onClick"
    Next
End Sub

sub麻辣君

Sub 批量添加图片()
On Error Resume Next '遇到错误代码，执行下一句
For Each shap In Sheet1.Shapes '遍历所有图形对象
If shap.Type <> 8 Then shap.Delete '如果图形对象类型不等于8，就删除它。这里类型8表示按钮
Next shap 'for循环结束语句
Set m = Sheet1.[d65536].End(3) '表sheet1的A列有数据最后一个单元格
For Each Rng In Range([d2], m) '遍历b2及以下有数据单元格
i = ThisWorkbook.Path & "\图片\" & Rng & ".jpg" '动态的图片位置
Set rngs = Cells(Rng.Row, 5) '动态的插入图片位置
Sheet1.Shapes.AddPicture i, True, True, rngs.Left + 2, rngs.Top + 2, rngs.Width - 3.5, rngs.Height - 3.5 '批量插入图片
Next Rng '循环结束语句
Call SetOnClick
End Sub
Private Sub SetOnClick()
    Dim x
    For Each x In ActiveSheet.Shapes
        If x.Type = msoLinkedPicture Then x.OnAction = "onClick"
    Next
End Sub