so I am trying to 'animate' a userform so that the text in a label changes over time. here is a sample of my code (it's run upon clicking a button in the userform):
Label2.Caption = "hello"
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "10"
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "9"
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "8"
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "7"
This should open with hello, then count from 10 to 7 with 1-second intervals.
When I run the code, the label changes to hello, then freezes for about 30 seconds, then, shows the last number. this problem does not happen if I step through the code with the debugger.
I've shown that Application.wait works on its own with this code (in a normal sub):
cells(1,1) = "hi"
Application.Wait (Now + TimeValue("0:00:01"))
cells(1,1) = "bye"
Application.Wait (Now + TimeValue("0:00:01"))
cells(1,1) = "hi"
how do I fix this and why is it broken?
EDIT:
This question is a duplicate. See this question
add .Repaint between changes. so my new code is:
Label2.Caption = "hello"
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "10"
myForum.Repaint
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "9"
myForum.Repaint
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "8"
myForum.Repaint
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "7"
myForum.Repaint
Related
I am trying to get all the buttons using queryselector and select the particular button by looping through and finding innerHTML.
After finding the particular button, when click event is passed, nothing happens.
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "https://www.spirit.com/"
Do Until IE.readyState = 4: Application.Cursor = xlDefault: DoEvents: Loop
Application.Wait (Now + TimeValue("00:00:03"))
IE.document.querySelector("label[for='radio-oneWay']").Click
Application.Wait (Now + TimeValue("00:00:03"))
IE.document.querySelector("input[id='flight-OriginStationCode']").Click
Set elems = IE.document.getElementsByTagName("button")
For Each elem In elems
If (elem.innerHTML) = " Aguadilla, Puerto Rico (BQN) " Then
elem.Click
Exit For
End If
Next elem
The two airport boxes can be assigned by simulating input using SendKeys then the click event will be triggered. The date-input and other textbox will be set separately. Here is the code which implements this function:
Private Sub CommandButton1_Click()
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "https://www.spirit.com/"
Do Until IE.readyState = 4: Application.Cursor = xlDefault: DoEvents: Loop
Application.Wait (Now + TimeValue("00:00:03"))
IE.document.querySelector("label[for='radio-oneWay']").Click
Application.Wait (Now + TimeValue("00:00:03"))
Set elems = IE.document.getElementsByTagName("button")
Set txt1 = IE.document.getElementsByName("originStationCode")(0)
txt1.Focus
SendKeys ("BQN")
Application.Wait (Now + TimeValue("00:00:01"))
Set txt2 = IE.document.querySelector("input[id='flight-DestinationStationCode']")
txt2.Focus
SendKeys ("BDL")
Application.Wait (Now + TimeValue("00:00:01"))
Application.Wait (Now + TimeValue("00:00:01"))
IE.document.querySelector("input[id='flight-Date']").Value = "2020/10/09-2020/10/19"
IE.document.querySelector("input[id='promoCode']").Value = "xx"
IE.document.querySelector("button[type='submit']").Click
End Sub
Result:
All my sendkeys execute properly and the document saves and closes but then the next document does not Open. Before I added the sendkeys, the documents in the DIR would each open but now the next document will not. What am I doing wrong?
Sub Password()
Dim CustRow, LastRow As Long
Dim Password As String
Dim fileName As Variant
With Sheet1
LastRow = .Range("C9999").End(xlUp).Row
fileName = Dir("C:\State_K-1_Info\Password\*.pdf")
Do While fileName <> ""
CreateObject("Shell.Application").Open ("C:\State_K-1_Info\Password\" & fileName)
Application.Wait Now + 0.00005
For CustRow = 2 To LastRow
Password = .Range("C" & CustRow).Value
Application.SendKeys "{F6}", True
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001
Application.SendKeys Password, True
Application.Wait Now + 0.00002
Application.SendKeys "(~)", True
Application.Wait Now + 0.00001
Application.SendKeys Password, True
Application.Wait Now + 0.00002
Application.SendKeys "(~)", True
Application.Wait Now + 0.00001
Application.SendKeys "(~)", True
Application.Wait Now + 0.00001
Application.SendKeys "^(s)", True
Application.Wait Now + 0.00001
Application.SendKeys "%{F4}", True
Application.Wait Now + 0.00001
fileName = Dir
Next CustRow
Loop
End With
End Sub
I'm struggling to create my first macro in VBA, I try to make simple macro which will switch button in each minute to present different data.
Right now I'm really frustrated, because each time I change something I receive different error, for sure I have issues with references to worksheet which I want to choose. Currently I get error "loop without do" and when I'm deleting loop, I get compile error "expected end with".
Please find my "work" below, and please let me how to make it work.
Public Sub Switch()
Do
For Each ws In ThisWorkbook.Worksheets
ControlBoard.Activate
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = True
.SlicerItems("YY").Selected = False
.SlicerItems("ZZ").Selected = False
Application.Wait Now("00:01:00")
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = False
.SlicerItems("YY").Selected = True
.SlicerItems("ZZ").Selected = False
Application.Wait Now("00:01:00")
End With
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = False
.SlicerItems("YY").Selected = False
.SlicerItems("ZZ").Selected = True
Application.Wait Now("00:01:00")
End With
Loop
End Sub
Ok, now I change it a bit and I get Run time error 13 (type mismatch) and I get debug on first line - Application.Wait Now("00:01:00")
Public Sub Switch()
Dim DashBoard As Sheet3
Do
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = True
.SlicerItems("YY").Selected = False
.SlicerItems("ZZ").Selected = False
Application.Wait Now("00:01:00")
End With
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = False
.SlicerItems("YY").Selected = True
.SlicerItems("ZZ").Selected = False
Application.Wait Now("00:01:00")
End With
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = False
.SlicerItems("YY").Selected = False
.SlicerItems("ZZ").Selected = True
Application.Wait Now("00:01:00")
End With
Loop
End Sub
I have solved type mismatch by adding + TimeValue
Application.Wait Now + TimeValue("00:01:00")
But slicer doesn't behave, as I want it. It gets me at beginning ("XX") true but further on it ticking ("YY") true and ("XX") still remains, as true, can you help me to solve it?
OK I have solved this by putting True statement in first line, it's freeze from time to time but it works, can you let me know, if it's possible to add switch off key, to avoid esc+esc exit?
Public Sub Switch()
Dim DashBoard As Sheet3
Do
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = True
.SlicerItems("YY").Selected = False
.SlicerItems("ZZ").Selected = False
Application.Wait Now + TimeValue("00:00:10")
End With
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("YY").Selected = True
.SlicerItems("XX").Selected = False
.SlicerItems("ZZ").Selected = False
Application.Wait Now + TimeValue("00:00:10")
End With
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("ZZ").Selected = True
.SlicerItems("XX").Selected = False
.SlicerItems("YY").Selected = False
Application.Wait Now + TimeValue("00:00:10")
End With
Loop
End Sub
So I have been trying to scrape info from a site using the code below but am having a tough time with the part I noted. Is there an easier way to get the results I want rather than just repeating the same code over and over? You never know how many results you will get so I cannot use that info.
Dim objIE As InternetExplorer
Dim y As Integer
Dim result As String
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.navigate "https://www.searchiqs.com/nyalb/Login.aspx"
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
objIE.document.getElementById("btnGuestLogin").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
objIE.document.getElementById("ContentPlaceHolder1_txtFromDate").Value = "07/01/2017"
objIE.document.getElementById("ContentPlaceHolder1_txtThruDate").Value = "07/19/2017"
objIE.document.getElementById("ContentPlaceHolder1_cboDocGroup").Value = "DBA"
objIE.document.getElementById("ContentPlaceHolder1_cmdSearch").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
y = 1
' brings up a table of results. I need to click on the view button and get the info from that page
objIE.document.getElementById("ContentPlaceHolder1_grdResults_btnView_0").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
' element ID's are hidden for those looking to help
result = Trim(objIE.document.getElementById("ContentPlaceHolder1_lblDetails2").innerText)
Sheets("Sheet1").Range("C" & y).Value = result
y = y + 1
' I would love to direct link to the next serch result here but the link does not change between pages so I click the next button
objIE.document.getElementById("ContentPlaceHolder1_btnNext").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
result = Trim(objIE.document.getElementById("ContentPlaceHolder1_lblDetails2").innerText)
Sheets("Sheet1").Range("C" & y).Value = result
y = y + 1
' and I click the next button again
objIE.document.getElementById("ContentPlaceHolder1_btnNext").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
result = Trim(objIE.document.getElementById("ContentPlaceHolder1_lblDetails2").innerText)
Sheets("Sheet1").Range("C" & y).Value = result
y = y + 1
'AND AGAIN
objIE.document.getElementById("ContentPlaceHolder1_btnNext").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
result = Trim(objIE.document.getElementById("ContentPlaceHolder1_lblDetails2").innerText)
Sheets("Sheet1").Range("C" & y).Value = result
y = y + 1
' You get the idea
objIE.document.getElementById("ContentPlaceHolder1_btnNext").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
result = Trim(objIE.document.getElementById("ContentPlaceHolder1_lblDetails2").innerText)
Sheets("Sheet1").Range("C" & y).Value = result
' I basically repeat that process til I cant press CTRL V anymore. Is there a loop I can use to tighten this up?
Let me know. You guys have been a huge help in the past. Also would it be beneficial to use the XML method as my readystate loops have been giving me issues? Thanks in advance.
Yep, a For loop for the required number of iterations if it's a static set of pages. I believe we can make it simpler.
For y = 1 to 5
result =trim(objIE.document.getElementById("ContentPlaceHolder1_lblDetails2").innerText)
Sheets("Sheet1").Range("C" & y).Value = result
objIE.document.getElementById("ContentPlaceHolder1_btnNext").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
next y
'or if you want it to keep going, something like this
Do until objIE.document.getElementById("ContentPlaceHolder1_btnNext") is nothing
result =trim(objIE.document.getElementById("ContentPlaceHolder1_lblDetails2").innerText)
Sheets("Sheet1").Range("C" & y).Value = result
objIE.document.getElementById("ContentPlaceHolder1_btnNext").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
loop
Application.SendKeys "{PGDN}", True
Works just fine, however Application.SendKeys "{%TAB}", True and Application.SendKeys "%{TAB}", True do nothing.
How do I execute an alt-tab with sendkeys to switch windows?
Here is the code:
Application.SendKeys "{PGDN}", True
Application.SendKeys "{PGDN}", True
xreply = MsgBox("Is this page for women? Record:" & i, vbYesNo, "Gender Checker")
If xreply = vbYes Then
ActiveSheet.Range("C" & i).Value = vbYes
End If
Use this:
Sub ReturnToWindows()
Application.SendKeys ("%{TAB}")
DoEvents
End Sub
Must be run while you are in Excel rather than the VBE.