【求助】在excel中点击图片放大3倍显示.

opel-wong

wpxxsyzx 发表于 2012-11-2 23:05
仅供参考，2007下的RangeFromPoint方法有bug，会失效

如果有办法克服2007/2010下的Bug就好了。
这个鼠标放在图片就放大的效果不错。

学习了！

.

wpxxsyzx

2010可以实现，2007有 bug

jeffreychan18

HHAAMM 发表于 2012-11-4 17:26
附件里代码 If a.AutoShapeType = -2 Then 改成 If a.AutoShapeType = 1 Then

为啥运行会有如图错误提示

jeffreychan18

jeffreychan18 发表于 2014-6-26 20:32
为啥运行会有如图错误提示

出现错误

aoe1981

HHAAMM 发表于 2012-11-3 02:36
稍稍修改一下

　　以下是HHAAMM版主的代码，为了学习、请教，妄自做了注，不太准确……

1. Sub test()
   
2. Dim a As Shape
   
3. For Each a In ActiveSheet.Shapes
   
4.     If a.AutoShapeType = 1 Then '1为自选图形
   
5.         If a.OnAction = Empty Then a.OnAction = "test"
   
6.         If a.Name = ActiveSheet.Shapes(Application.Caller).Name Then 'application.caller代表调用它的对象
   
7.             If a.AlternativeText = Empty Then
   
8.                 a.AlternativeText = a.Height & Chr(28) & a.Width '记录初始尺寸
   
9.                 a.Height = a.Height * 3
   
10.                 a.Width = a.Height * 3
    
11.                 a.ZOrder msoBringToFront '应该是置于顶层
    
12.                 Exit Sub
    
13.             Else
    
14.                 a.Height = Split(a.AlternativeText, Chr(28))(0) '分解初始尺寸为高、宽
    
15.                 a.Width = Split(a.AlternativeText, Chr(28))(1)
    
16.                 a.AlternativeText = Empty
    
17.             End If
    
18.         End If
    
19.     End If
    
20. Next
    
21. End Sub

复制代码

leafsea

发现一个bug。
在excel2010下，将 If a.AutoShapeType = -2改为 If a.AutoShapeType = 1后，可以实现点击放大功能，但是鼠标指向放大还是不能实现。

而且新插入图片后有个更大的问题：
点击新图片后，原有的第一张图片会先出现在新图片位置，再点击一次才放大新图片，这就非常影响使用了。

目前，我只发现一个解决办法：添加新图片后，保存关闭excel后再打开，可以点击放大。

leafsea

wpxxsyzx 发表于 2012-11-2 23:05
仅供参考，2007下的RangeFromPoint方法有bug，会失效

wpxxsyzx 朋友的方法在win7 64位系统下失效，应该是系统API问题：
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public iTimerID As Long, timeX As Single
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

aoe1981

楼主可看以下香川在下帖中的解释：
http://club.excelhome.net/forum. ... 747&pid=7799730