精华内容
下载资源
问答
  • Randomize private function getInt()  dim n,m as integer  Randomize  n=1 m=3  getInt=Int((m+1-n)*rnd + n) ...DoEvents dim c as Boolean private sub gameMain()  while c...

    Randomize

    private function getInt()

      dim n,m as integer

      Randomize

      n=1

         m=3

      getInt=Int((m+1-n)*rnd + n)

     end function

     

    DoEvents

    dim c as Boolean

    private sub gameMain()

      while c

        Do Until z <> iNew

          iNew = getnt

        loop

        z = iNew

               Image1.Picture = LoadPicture(path)

        doEvents

      Wend

    end sub

    private sub do()

      dim str as String

      str = iif(str = "s","L","S")

      c = not c

      gameMain

    end sub

    转载于:https://www.cnblogs.com/liangx85/p/3484821.html

    展开全文
  • vba技巧

    2014-03-04 19:44:18
    循环运行避免时避免假死: 我在循环中写操作后面加入了doevents

    循环运行避免时避免假死:

    在循环中写操作后面加入了doevents


    写word时避免word自动分页,提高效率:

    切换到大纲视图,file->preference->高级->去掉勾选后台自动分页

    展开全文
  • 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 =...
  • QQ vba 登 录

    2013-03-15 12:24:39
    DoEvents Loop .document.getelementbyid("u").Value = "123456789" .document.getelementbyid("p").Value = "3s3.cn***" .document.getelementbyid("button").Click '登 录 Do Until .readystate = 4 ...
  • VBA爬网页数据

    2021-03-31 16:04:53
    方法1 :CreateObject(“InternetExplorer.Application”) Sub 方法1() ...Set ie = CreateObject("InternetExplorer.Application") With ie .Visible = False .navigate LinkStr ... DoEvents Loop

    方法1 :CreateObject(“InternetExplorer.Application”)

    Sub 方法1()
    LinkStr = "https://www.csdn.net/"
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = False
        .navigate LinkStr
        Do Until .readystate - 4
            DoEvents
        Loop
         Set oDom = .document
    End With
           Debug.Print oDom.getElementsByTagName("p")(0).innertext
    End Sub
    

    PS:此方法会打开浏览器读取数据,虽然我们看不到打开浏览器是因为设置的:.Visible = False不可见,实际在后台操作。并且需要等待浏览器返回数据的时间,不然可能会跳出错误。

    方法2 :CreateObject(“WinHttp.WinHttpRequest.5.1”)

    Sub 方法2()
    LinkStr = "https://www.csdn.net/"
    
    Set xmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
     Set oDom = CreateObject("htmlFile")
    With xmlHttp
        .Open "GET", LinkStr, False
        .send
        oDom.body.innerHTML = .ResponseText
    End With
    Debug.Print oDom.getElementsByTagName("p")(0).innertext
    End Sub
    

    PS:
    1、此方法如果P标签内为汉字,返回的为乱码,
    2、使用WPS用户访问外部网站会跳出安全频道的错误,局域网网址并不会出现,此问题暂时无解。
    在这里插入图片描述

    方法3:CreateObject(“msxml2.xmlhttp”)

    Sub 方法3()
    Dim oDom As Object
    LinkStr = "https://www.csdn.net/"
    Set oDom = CreateObject("htmlFile")
    Set ms = CreateObject("msxml2.xmlhttp")
    With ms
        .Open "GET", LinkStr, True
        .send
        oDom.body.innerHTML = .responseText
    End With
    Debug.Print oDom.getElementsByTagName("p")(1).innertext
    End Sub
    

    PS:
    1、msxml2可以自动适应字符乱码问题,兼容性较强。
    2、缺点对于对于已经访问的 网站,如果网站内更新的内容,仍然是以前的老数据。原因msxml2是读取的上次缓存的数据才造成的。
    解决方案:程序运行前先清空浏览器缓存。使用:Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 "。如果不行,请自行测试下其他方式,注释及方法纯个人理解,难免有差错。

    Sub Clear_Temp_Files()
    Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8 " '清除临时文件
    End Sub
    
    Sub Clear_Cookies()
    Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 2" '清除Cookies
    End Sub
    
    Sub Clear_History()
    Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 1" '清除历史记录
    End Sub
     
    Sub Clear_Form_Data()
    Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 16" '清除表单数据
    End Sub
    
    Sub Clear_Saved_Passwords()
    Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 32" '清除记住的账号密码
    End Sub
     
    Sub Clear_All()
    Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 255" '清除所有
    End Sub
    
    Sub Clear_Clear_Add_ons_Settings()
    Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 4351" '清除创建默认设置
    End Sub
    

    方法4: CreateObject(“Msxml2.ServerXMLHTTP”)

    Sub 方法3()
    Dim oDom As Object
    LinkStr = "https://www.csdn.net/"
    Set oDom = CreateObject("htmlFile")
    Set ms =  CreateObject("Msxml2.ServerXMLHTTP")
    With ms
        .Open "GET", LinkStr, False
        .send
        oDom.body.innerHTML = .responseText
    End With
    Debug.Print oDom.getElementsByTagName("p")(1).innertext
    End Sub
    

    PS:
    1、与方法3基本一致,唯一不同是加上此方法不会造成数据缓存的问题,保证读取的数据都是最新的。
    2、和方法2问题一样WPS用户访问外部网站会跳出安全频道的错误,局域网网址并不会出现,此问题暂时无解


    解决CreateObject(“WinHttp.WinHttpRequest.5.1”)乱码问题

    Function UrlFile(Url, Ucode) '获取网页源文件(网址,编码)
        Dim oServerXmlHttp, ObjStream, oStream
        Set oServerXmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
        oServerXmlHttp.Open "GET", Url, False
        oServerXmlHttp.send
        oStream = oServerXmlHttp.responseBody
        If Not IsEmpty(oStream) Then
            If InStr(1, oServerXmlHttp.getResponseHeader("content-type"), "charset", 1) Then '通过判断"content-type"是否有"charset"字符串来决定是否根据参数2转码(文本比较——不区分大小写)
                UrlFile = oServerXmlHttp.responseText
            Else
                Set ObjStream = CreateObject("Adodb.Stream") 'With...end with省略对象不可写在判断内
                ObjStream.Type = 1
                ObjStream.Mode = 3
                ObjStream.Open
                ObjStream.Write oStream
                ObjStream.Position = 0
                ObjStream.Type = 2
                ObjStream.Charset = Ucode
                UrlFile = ObjStream.ReadText
            
            End If
        Else
            UrlFile = ""
        End If
        
        Set ObjStream = Nothing: Set oServerXmlHttp = Nothing
    End Function
    
    
    Sub 读取整个网页()
    tex = UrlFile("https://www.csdn.net/", "UTF-8")
    Debug.Print tex
    End Sub
    
    

    其他问题(获取某个标签的值)

    使用以下方法时有时会出现自动打开网页问题:

    方法2 :CreateObject(“WinHttp.WinHttpRequest.5.1”)
    方法3:CreateObject(“msxml2.xmlhttp”)
    方法4: CreateObject(“Msxml2.ServerXMLHTTP”)

    后来发现是oDom在作怪,在oDom.body.innerHTML = .ResponseText数据转换时会发生。
    解决方案:
    不使用oDOM,使用正则表达式取值,假如我要取所有P标签的值,如下

    Part = .responseText
     Set re = CreateObject("VBScript.RegExp")
        re.Pattern = "<p.*>(.*?)</p>"
        're.Pattern = "p>.*[\s\S]*</p"
        re.Global = True
        re.IgnoreCase = False
        Set matchs = re.Execute(OrgStr)
       
        For Each m In matchs
            Debug.Print m.submatches(0) 
        Next
        
    

    完结
    如果你感觉还不够,请访问我一老哥的文章希望能帮到你 链接: VBA 网页提取特定内容 - 网抓实践总结.

    展开全文
  • VBA实现进度条的显示

    2010-06-27 07:36:12
    VBA实现进度条的显示 Sub Test() ' The UserForm1_Activate sub calls Main UserForm1.LabelProgress.Width = 0 UserForm1.Show End Sub Private Sub UserForm_activate() Call Main End Sub Sub Main() ' ...
  • vba之网抓详细事例

    2018-05-27 22:38:01
    VBA抓取网页数据详细教程,举例抓取网页中的表格数据 Sub test() Dim ie, dmt, tbs, i&, tb Set ie = CreateObject("InternetExplorer.Application") '创建一个IE对象 With ie .Visible = True '显示它 ....
  • 'Excel VBA 打开百度网页输入关键字并搜索 Dim KW, Su With CreateObject("InternetExplorer.Application") .Navigate "http://www.baidu.com/" .Visible = True Do Until .readyState = 4 DoEvents Loop 'Set KW = ...

    Sub 百度搜索()
    'Excel VBA 打开百度网页输入关键字并搜索
    Dim KW, Su
    With CreateObject("InternetExplorer.Application")
    .Navigate "http://www.baidu.com/"
    .Visible = True
    Do Until .readyState = 4
    DoEvents
    Loop
    'Set KW = .document.getElementsByName("wd")
    'KW.Item(0).Value = "QQ"
    .document.getElementsByName("wd").Item(0).Value = "QQ" '等同上面2句
    'Set Su = .document.getElementByid("f")
    'Su.Submit
    .document.getElementByid("f").Submit '等同上面2句
    End With
    Set Su = Nothing
    Set KW = Nothing
    End Sub


    展开全文
  • ...DoEvents相当于本线程唤醒了系统线程,让画面不会卡住。   Private Declare Function timeGetTime Lib "winmm.dll" () As Long Sub sleep(ts) '线程睡眠函数 Dim t, t1 ...
  • 我看文献说,VBA6.3就支持多线程了,是所谓的能让2+个进程同时运行吗? 比如我下面的例子: 下面是2个段非常简单的代码 Sub sum1() Dim i1 As Integer For i1 = 1 To 30000 Range("A1") = i1 DoEvents Next End...
  • Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.SendKeys &...DoEvents End Sub 参考:https://zhidao.baidu.com/question/1923643304371724907.htmlhttps://baike.baidu.com/item/send...
  • Private Sub UserForm_Activate() For i = 1 To 20000 DoEvents Cells(i, 1) = i Next Unload UserForm1 End Sub
  • Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long '封装延时函数 Sub delay(T As Long) Dim time1 As Long time1 = timeGetTime ... DoEvents Loop While timeGetTi...
  • 这是一个简单的计时器 Private Sub CommandButton1_Click() Dim Duration, Start As Long Duration = TextBox2.Text Start = Timer Do While Timer DoEvents TextBox1.Text = Du
  • Sub get_record() On Error Resume Next For i = [a65536].End(xlUp).Row To 1 Step -1 MsgBox i DoEvents For y = 1 To 255 MsgBox y 
  • DoEvents End Sub Sub EndTimer()'触直接excel闪退 On Error Resume Next KillTimer 0&, TimerID End Sub Sub TimerProc() mymy = mymy + 1 Sheet1.Cells(5, 5) = mymy End Sub
  • DoEvents Sleep 100 Application.SendKeys "%s" End Function ' 发送单个邮件的子程序 Sub SendMail(ByVal to_who As String, ByVal subject As String, ByVal body As String, ByVal attachement As String) ...
  • <div><pre><code> DoEvents: blah </code></pre> <p>"Line label 'Doevents' is not used"</p><p>该提问来源于开源项目:rubberduck-vba/Rubberduck</p></div>
  • SLL mode failed while parsing the CodePaneCode version of module Module1 at symbol DoEvents at L8C10. Retrying using LL.; 2019-06-04 15:49:59.3384;ERROR-2.4.1.4729;Rubberduck.Parsing.VBA.Parsing....
  • 2021-02-19

    2021-02-19 23:10:05
    excel vba问题!求求大神!红包在线等! Sub 试试() Dim KW, Su With CreateObject(“InternetExplorer.Application”) .navigate “http://cmdpms.wilmar.cn” .Visible = True Do Until .readyState = 4 DoEvents ...
  • excel定时定时执行

    2012-11-14 08:24:38
    是EXCEL的定时执行 Sub OntimeRun() '运行前用k先判断是否运行 If k = False Then Exit Sub Else '执行程序aa Call aa '如果k=true,那么每隔3秒执行程序OntimeRun ... VBA.DoEvents End Sub
  • censuspopdata,数据挑选

    2020-09-22 18:07:28
    今天看了一篇Python编写电子表格的视频,以自己薄弱的编程知识,想着用VBA实现相同的功能,结果,悲剧了。DoEvents还是今天刚查得的,虽时间更长,但是不出现“未响应”的字样了,为什么不刷屏,是为了节省时间。...
  • VBA的区别仅是把“DoEvents”换为“Wscript.sleep 800”即可。 ------------------------------------------------------------以上为转载者的注明-------------------------------------------------------------...
  • - [x] DoEvents <p><strong>File system - [x] Kill - [ ] Move - [ ] Name - [ ] FileCopy - [x] MkDir - [x] RmDir - [ ] Dir - [x] ChDir - [x] ChDrive - [x] CurDir - [ ] EOF - [ ] FreeFile - [ ] FileAttr -...
  • expecting {ABS, ANY, ARRAY, B_CHAR, BF, CBOOL, CBYTE, CCUR, CDATE, CDBL, CDEC, CINT, CIRCLE, CLNG, CLNGLNG, CLNGPTR, CSNG, CSTR, CURRENCY, CVAR, CVERR, DEBUG, DOEVENTS, EXIT, FIX, INPUTB, INT, LBOUND...
  • <p>For example, the VBA code that I use to do this. <pre><code>Set oFields = CreateObject("Scripting.Dictionary") With oFields .Add "login", "sdiscor" .Add "password", "sdiscor" End With For Each ...
  • <div><p>I have Method (A) which receives a parameter, but doesn't explicitly change that parameter. Instead, it passes it to Method (B) which changes the value ...rubberduck-vba/Rubberduck</p></div>
  • <p>VBA code works well <pre><code>Set oFields = CreateObject("Scripting.Dictionary") With oFields .Add "dor_user", "51" .Add "login", "nvivc" .Add "pass", "51256" End With For Each sName In ...

空空如也

空空如也

1 2
收藏数 29
精华内容 11
关键字:

doeventsvba