|
|
楼主 |
发表于 2016-7-23 22:36
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
'《判断是否按住Ctrl键》
《声明函数》：
Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
'参数很简单,只要传入特定键的虚拟键码即可,关于虚拟键码--就是API浏览器中VK_类的常数，而一般字母、数字就用其ASCII码值（注意要用大写字母的ASCII值），如keys=GetKeyState(Asc("A"))不要写成keys=GetKeyState(Asc("a"))！有趣的是也可以检测鼠标按键是否按下，声明键码VK_LBUTTON(左键)，VK_RBUTTON（右键）传入即可，如:
Public Const VK_CONTROL = &H11
《在过程调用前添加判断》：
If GetKeyState(VK_CONTROL) = -127 Or GetKeyState(VK_CONTROL) = -128 Then Call 帮助动画1: Exit Sub
《调用相应动画》：
Public Sub 帮助动画1()
On Error GoTo 100
Set xlapp = GetObject(, "excel.application")
Dim str$
str = App.path & "\我的软件\演示动画\" & wddh & ".gif"
If Left(str, Len(wddh & ".gif")) <> wddh & ".gif" Then MsgBox "提示：作者未录制本动画，或您安装的非E神 for Excel完整版。": Exit Sub
If ckdhfs = 6 Then
Shell ("cmd.exe /c ") & App.path & "\我的软件\演示动画\" & 动画名称& ".gif", 0
ElseIf ckdhfs = 7 Then
Dim i As Integer, CtlName, sPath As Variant
Dim x, y As Integer
Dim Gif As OLEObject
sPath = App.path & "\我的软件\演示动画\" & wddh & ".gif"
'禁止屏幕更新
xlapp.ScreenUpdating = False
xlapp.Workbooks.Add
'excel 计算高度不是按照像数，有个换算的比例
x = 1900
y = 1000
xlapp.ActiveSheet.OLEObjects.Add(ClassType:="Shell.Explorer.2", Link:=False, _
DisplayAsIcon:=False, Width:=x, Height:=y, Top:=xlapp.Selection.Row * 10).Select
Set Gif = xlapp.ActiveSheet.OLEObjects(xlapp.Selection.Name)
Do While Gif.Object.Busy
DoEvents
Loop
'由于使用的是WebBrowser控件，保存的时候会删除写入的css，所以打开的时候会出现滚动条
Gif.Object.navigate sPath
Gif.Object.Document.Open
Gif.Object.Document.writeln "<HTML>"
Gif.Object.Document.writeln "<HEAD>"
Gif.Object.Document.writeln "<TITLE>"
Gif.Object.Document.writeln "</TITLE>"
Gif.Object.Document.writeln "</HEAD>"
Gif.Object.Document.writeln "<BODY scroll=" & VBA.Chr(34) & "no" & VBA.Chr(34) & " oncontextmenu=self.event.returnValue=false>"
Gif.Object.Document.writeln "<div style=" & VBA.Chr(34) & "position:absolute; left: 0;right: 0; top: 0" & VBA.Chr(34) & ">"
Gif.Object.Document.writeln "<IMG SRC=" & VBA.Chr(34) & sPath & VBA.Chr(34) & " BORDER=" & VBA.Chr(34) & "0" & VBA.Chr(34) & ">"
Gif.Object.Document.writeln "</div>"
Gif.Object.Document.writeln "</BODY>"
Gif.Object.Document.writeln "</HTML>"
xlapp.Worksheets.Add
xlapp.DisplayAlerts = False
xlapp.ActiveSheet.Delete
xlapp.DisplayAlerts = True
' xlapp.StatusBar = False
100:
xlapp.ScreenUpdating = True
End If
End Sub |
|
楼主: 1615720058
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2016-8-4 16:45
