精华内容
下载资源
问答
  • VBA中让程序休眠 SLeep的方法

    万次阅读 2017-08-02 22:06:08
    在最上部,定义 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 在程序中 Sleep 500

    在最上部,定义

     

    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

     

    在程序中

     

    Sleep 500

     

     

     

     

     

    展开全文
  • 这里自定义了sleep函数,参数毫秒。 DoEvents相当于本线程唤醒了系统线程,让画面不会卡住。   Private Declare Function timeGetTime Lib "winmm.dll" () As Long Sub sleep(ts) '线程睡眠函数 ...

     当用户点击ppt中的按钮时,会产生一个连续的动画。一直到下一次点击时停止动画。

    这里自定义了sleep函数,参数毫秒。

    DoEvents相当于本线程唤醒了系统线程,让画面不会卡住。

     

    Private Declare Function timeGetTime Lib "winmm.dll" () As Long
    
    
    
    Sub sleep(ts) '线程睡眠函数
    
    Dim t, t1
    
    t = timeGetTime
    
    Do
    
    t1 = timeGetTime
    
    If t1 < t Then t1 = 86400 + t1
    
    DoEvents
    
    Loop Until t1 - ts > t
    
    End Sub
    
    
    
    Sub run_it()
    
    Debug.Print "theClassIndex=" & theClassIndex
    
    Debug.Print "theIndex=" & theIndex
    
    If status Then '停下来
    
    status = False
    
    ActivePresentation.Slides(1).Shapes("Rounded Rectangle 6").Visible = msoTrue '开始
    
    ActivePresentation.Slides(1).Shapes("Rounded Rectangle 14").Visible = msoFalse '停止
    
    Else '开始动画
    
    If theClassIndex = -1 Then
    
    MsgBox "全部开始已完成,如要保存结果请保存此PPT。" & vbCrLf & "如要全部重新开始,请点重置!"
    
    Exit Sub
    
    End If
    
    'Debug.Print "进来了1"
    
    status = True
    
    ActivePresentation.Slides(1).Shapes("Rounded Rectangle 14").Visible = msoTrue '停止
    
    ActivePresentation.Slides(1).Shapes("Rounded Rectangle 6").Visible = msoFalse '开始
    
    'Debug.Print "进来了2"
    
    Savetime = timeGetTime '记下开始的时间
    
    Dim k As Integer
    
    k = 0
    
    Do While status
    
    Savetime = timeGetTime '记下开始的时间
    
    Debug.Print Savetime
    
    If k < UBound(sh_name_arr) Then
    
    ActivePresentation.Slides(1).Shapes("TextBox 5").TextFrame.TextRange.Text = sh_name_arr(k)
    
    Debug.Print "旋转" & k & sh_name_arr(k)
    
    k = k + 1
    
    Else
    
    k = 0
    
    ActivePresentation.Slides(1).Shapes("TextBox 5").TextFrame.TextRange.Text = sh_name_arr(k)
    
    Debug.Print "旋转" & k & sh_name_arr(k)
    
    k = k + 1
    
    End If
    
    sleep (50)
    
    Loop
    
    Exit Sub '还没有点停,不抽出
    
    End If
    
    '不是动画时,做其他事,写这里
    
    End Sub

     

    展开全文
  • VBA host 中实现 Sleep() 函数

    千次阅读 2006-07-25 18:06:00
    vba 中需要使用 sleep() 函数. 想当然, 一开始是这样实现的:STDMETHODIMP CShell::Sleep(int nMillSeconds){ ::Sleep(nMillSeconds); return S_OK;} 但很快就发现这样不行. Sleep 的时候, 程序主界面死了. ...

    在 vba 中需要使用 sleep() 函数.
    想当然, 一开始是这样实现的:
    STDMETHODIMP CShell::Sleep(int nMillSeconds)
    {
     ::Sleep(nMillSeconds);
     return S_OK;
    }
     
    但很快就发现这样不行.  Sleep 的时候, 程序主界面死了.
    应该用 GetMessage() 来实现. 但 GetMessage() 是阻塞的. 不拿到一条消息不会返回.
    我需要的是 GetMessageTimeOut(), 可以指定一个超时. 超时后不管有没有消息都返回.
    可惜 MSDN 里没有这样的函数.
    那就只好在循环里面 PeekMessage(), 发现有消息再 GetMessage() 了. 象这样:

    STDMETHODIMP CShell::Sleep(int nMillSeconds)
    {
     for (int n = 0; n < nMillSeconds; n += 50)
     {
      MSG msg;
      while (PeekMessage(&msg, NULL, NULL, NULL, PM_NOREMOVE))
      {
       if (GetMessage(&msg, NULL, NULL, NULL))
       {
        TranslateMessage(&msg);
        DispatchMessage(&msg);
       }
      }
      ::Sleep(50);
     }
     return S_OK;
    }

    这样子能够满足需要. 但还是不够完美. 每 50ms 醒来一次. 醒来只是为了继续睡觉.
    我需要的是一直睡, 直到指定的时间再醒来. 并且还得在睡觉的时候有消息还得处理消息.
    还是 GetMessage(), 如果在指定的时间到了之后收到一条不管什么消息. 让 GetMessage() 返回即可.
    既然是指定的时间之后的消息, 那 WM_TIMER 就很自然了. 最后的实现是这样的:

    STDMETHODIMP CShell::Sleep(int nMillSeconds)
    {
     MSG msg;
     int nTimerID = SetTimer(NULL, 0, nMillSeconds, NULL);
     while (GetMessage(&msg, NULL, NULL, NULL))
     {
      if (msg.message == WM_TIMER && msg.wParam == nTimerID)
       return S_OK;
      TranslateMessage(&msg);
      DispatchMessage(&msg);
     }

     return S_FALSE;

    展开全文
  • VBA

    2010-06-06 12:47:00
    <br />Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) <br />Private Sub CommandButton1_Click() Dim data As String Dim filepath As String Dim row As ...


    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


    Private Sub CommandButton1_Click()

    Dim data As String
    Dim filepath As String
    Dim row As Integer
    Dim cid As Integer
    Dim num As String

    On Error GoTo err

        Call DelRows(2, 4)
        
        filepath = ThisWorkbook.Path & "/双色球.txt"
       
       
        Open filepath For Input As #1
       
         If Not EOF(1) Then
            Line Input #1, data
        End If
        Close #1
       
        If data = "" Then
          MsgBox "没有可操作的数据,请先生成数据再操作。", vbInformation, "提示"
          Exit Sub
        End If
       
        row = Sheets(1).UsedRange.Rows.Count + 1

        cid = 2

        Open filepath For Input As #1
       
        While Not EOF(1)
       
            Line Input #1, data
       
            Sheets(4).Cells(cid, 1).value = Mid(CStr(data), 1, 18)
            Sheets(4).Cells(cid, 2).value = Mid(CStr(data), 21, 3)
            Sheets(4).Cells(cid, 3).value = Mid(CStr(data), 27, 3)
            Sheets(4).Cells(cid, 4).value = Mid(CStr(data), 33, 7)
             
       
        cid = cid + 1
       
        Wend
        Close #1
       
        ThisWorkbook.Application.StatusBar = "共导入数据:" & cid - 2 & " 条."
       
        '''''''''''''' 统计区间比个数'''''''''''''''''''''''''''''''''''''''''''''''
       
    Dim filterG As Integer
    Dim filterD As Integer
    Dim isum As Integer
     
    isum = 0
     
    Sheets(4).Activate


    Set rng = Range("D:D")

    rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("G:G"), Unique:=True '高级筛选到IV列

    Sleep (500)

     '返回G列最后一行
     filterG = Range("G65536").End(xlUp).row
     
     filterD = Range("D65536").End(xlUp).row
     
      For i = 2 To filterG
       
         For J = 2 To filterD
       
          If Sheets(4).Cells(i, 7).value = Sheets(4).Cells(J, 4).value Then
             isum = isum + 1
          End If
       
        Next J
       
        Sheets(4).Cells(i, 8).value = isum
       
        isum = 0
       
      Next i
     

    ' Sheets(4).Cells(1, 7).value = "区间比统计"
     
     ActiveSheet.Rows(1).AutoFilter
       
       
    Exit Sub

    err:
    Close #1

    MsgBox "没有下载到数据,请先生成数据再操作,系统错误信息为:" & err.Description, vbInformation, "信息"


    End Sub

    Private Sub Worksheet_Deactivate()
      ThisWorkbook.Application.StatusBar = "就绪"
    End Sub

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    End Sub

     

    展开全文
  • 一个应用接口需要限制运行速度,需要在循环中加个延时函数,这个延时不需要多么精确,要求有个几秒延时,网上用的比较多的就是用Timer函数编写,Timer是VBA自带的函数,用起来比较方便,一般程序如下: '延时程序 ...
  • VBA使用宏卡顿解决

    2021-01-03 00:44:43
    前几天使用GBA的宏,然后内存占用非常高。 然后导入了SLEEP函数,将进程减速以后,内存占用降低了。...明显,使用VBA宏的时候,建议使用OFFICE 2003 。 揣测:可能是因为OFFICE 2016画质特效占用太多内
  • #EXCEL VBA工程让程序休眠1秒钟 首先在最上部,定义 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 在程序中使用: Sleep 1000
  • VBA如何多线程运行?

    2020-12-21 19:43:52
    <p>VBA用循环语句,For sleep和doevents实现了单元格文字闪烁 <p><br /> For i = 1 To 4 [F1].Font.Color = RGB(0, 0, 0) DoEvents Sleep 300 [F1].Font.Color =...
  • vba 执行 *.py

    千次阅读 2017-05-11 20:04:11
    aa.py 文件 # -*- coding: UTF-8 -*- import time import os #linux  os.system('cls')  print ("asdfasdf") print ("hellow world"); print ("你好,世界");...time.sleep(2);...vba函数
  • 1_VBA_POWERSHELL病毒分析

    2020-03-17 18:22:44
    文章目录分析VBA_PS脚本: 样本信息: MD5 0bf87fd5ff555a5f0fc94b5e36f0d4ff 文件名称 0bf87fd5ff555a5f0fc94b5e36f0d4ff.doc ...Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds A...
  • 防止Windows自动锁屏的VBA脚本

    千次阅读 2017-07-07 10:13:55
    一个很简单的VBA脚本,可以防止Windows自动锁屏。 主要是利用了一个不常用的键 NUMLOCK。 ' 先定义一个Shell对象 Set WshShell = WScript.CreateObject("WScript.Shell") WScript.Sleep 5000 wshShell.Send...
  • 第一次使用VBA从网上下载了一张图片,挺有意思!哈哈。代码:#If Win64 Then Private Declare PtrSafe Sub sleepp Lib "kernel32.dll" Alias "Sleep" (ByVal dwMilliseconds As LongLong) ...
  • Timer based Sleep Evasion

    2020-12-25 18:42:44
    How to manage this samples?... Since the VBA timer is based on the local system time this will bypass this evasion:"</p><p>该提问来源于开源项目:spender-sandbox/cuckoo-modified</p></div>
  • VBA,实现延时自动执行的各种方法

    千次阅读 2020-03-15 09:59:07
    需要加载新的库,Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) sleep 毫秒数 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Declare Sub Sleep Lib "ke...
  • 【Python】如何在VBA中调用Python脚本

    万次阅读 2015-03-29 22:40:20
    已有一个Python脚本实现了部分功能,想使用VBA直接调用Python脚本 Python脚本如下: import time def hello(name): return "Hello, " + name + "!" print hello("World") #延时关闭windows控制台,使得用户...
  • 暂停程序的3个思路 暂停 application.wait(now + timevalue("00... sleep 500 加入断点,然后点F5运行一下不就暂停了吗? stop 不行,程序运行时被挂起了 运行的时候程序是挂起的吧,只能加暂停的代码才能让你玩...
  • Option Explicit '---------------------...Private Declare Sub AppSleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long) '-----------------------------------------------------------------------...
  • 大家好,我们今日继续讲解VBA代码解决方案的第82讲内容:如何利用代码让程序延时,SLEEP函数和timeGetTime函数两个API函数的讲解。在上一讲中我们讲了使用Wait方法,但这种方法的不足是只能提供精度为1秒的延时,...
  • VB&VBA实现延时的几种方法

    千次阅读 2012-08-15 21:29:55
    在程序流程中经常要延时一段时间后...1.使用Windows API函数Sleep  新建一个工程,添加一个TextBox控件和一个CommandButton控件,再将以下代码复制到代码窗口 "声明: Private Declare Sub Sleep Lib "kernel32" (ByV
  • VBA 实现 POWERPOINT 的TIMER 事件

    千次阅读 2005-10-09 22:02:00
    笔者曾为此十分苦恼,四处求救,始终没有满意的答复(多数建议添加FLASH 格式的CLOCK),近日想起了延时函数SLEEP,一试竟然成功,问题终于得以解决,特此与广大CSDN朋友共享。代码如下Option ExplicitPrivate ...
  • 在程序流程中经常要延时一段时间后再...使用Windows API函数Sleep 新建一个工程,添加一个TextBox控件和一个CommandButton控件,再将以下代码复制到代码窗口"声明:Private Declare Sub Sleep Lib "kernel32" (ByVal d
  • Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ...
  • 使用VBA代码,自定义页面数拆分大Word文件为多个小文档并指定名称保存 alt+F11打开开发选项-->选择【插入】-->【模块】-->弹出代码编辑窗口,插入下面代码,按照需要修改页数和要重命名的每个文档按顺序的...
  • 在程序流程中经常要延时一段...使用Windows API函数Sleep新建一个工程,添加一个TextBox控件和一个CommandButton控件,再将以下代码复制到代码窗口:Private Declare Sub Sleep()Sub Sleep Lib "kernel32" (ByV
  • Sleep 10 Call Set_Com(hComm) Sleep 10 Call Set_Com(hComm2) Sleep 10 Call Write_Com(hComm2, "abc") Sleep 500 Call Read_Com(hComm) Sleep 10 CloseHandle hComm hComm = 0 CloseHandle ...

空空如也

空空如也

1 2 3
收藏数 47
精华内容 18
关键字:

sleepvba