I am bumped in a situation where I need to do something if an element exists, and if that element does not exists I will need to skip to the rest of the code. I have tried several methods but I do not know why it does not work, the code looks logical to me and it worked for similar macros.
Code below:
Do
DoEvents
Loop Until driver.ExecuteScript("document.readystate") <> "complete"
If driver.FindElementByName("x").IsPresent Then
Item.Offset(0, 2).Value = "Completed already" 'And need to skip to next iteration
ElseIf driver.FindElementByName("x") Is Nothing Then
Set cancel= driver.FindElementByName("cancelbutton")
cancel.Click
Set myVar= Item.Offset(0, 1)
Set radiobtn = driver.FindElementByXPath("//input[#value='" & myVar & "']")
radiobtn.Click
Set cancelSelected = driver.FindElementByName("submitCancel")
cancelSelected.Click
driver.SwitchToAlert.Accept
Item.Offset(0, 2).Value = "Canceled"
driver.Refresh
driver.Wait 1000
End If
I have also tried the situation where if the element X is present, then find other element
If driver.FindElementByName("x").IsPresent Then
Item.Offset(0, 2).Value = "Completed already"
ElseIf driver.FindElementByName("Y").IsPresent Then
Set cancel= driver.FindElementByName("cancelbutton")
cancel.Click
Set myVar= Item.Offset(0, 1)
Set radiobtn = driver.FindElementByXPath("//input[#value='" & myVar & "']")
radiobtn.Click
Set cancelSelected = driver.FindElementByName("submitCancel")
cancelSelected.Click
driver.SwitchToAlert.Accept
Item.Offset(0, 2).Value = "Canceled"
driver.Refresh
driver.Wait 1000
End If
When element X is present on the page element Y is not, and vice versa. I have also tried .count > 0 but it still does not work. Could anyone help me with a solution or give me some tips and trick?
Actually, I bought a course on Udemy and found the answer myself. There are several ways to find if an element is present and what to do next if it is or not present. Funny, the solution is so simple that I'm embarrassed I missed it.
First Dim By AS New By
Then add a split second of wait before and after the if clause:
driver.Wait 500
If driver.IsElementPresent(By.Name("uncompleteButton__")) Then
Item.Offset(0, 2).Value = "Can't do stuff, go to next iteration."
Else
Set cancelitemsbtn = driver.FindElementByName("cancelButton")
cancelitemsbtn.Click
Item.Offset(0, 2).Value = "Can do stuff"
driver.Wait 500
End if
Try to use not driver.findelement but driver.findelements(By.whatever).size()>0 I hope it works with vbs, it works with Java 100%.
Related
I'm writing macro that will make BOM list from the selected parts in assembly.
I can get a "Part Number" of the part in assembly, I can't get a "Instance name" of the selected parts.
Here code that call Selection tab and then try to get a names.
Set ItemSelection = CATIA.ActiveDocument.Selection
InputObjectType(0) = "Part"
SelectionStatus = ItemSelection.SelectElement3(InputObjectType, "Choose parts", false, CATMultiSelTriggWhenUserValidatesSelection, true)
If SelectionStatus = "Cancel" Then
Exit Sub
End If
If ItemSelection.Count >= 1000 Then
MsgBox "You select more then 1000 parts.", vbExclamation, MsgTextBox & "."
Exit Sub
End If
For i = 1 To ItemSelection.Count
k = k + 1
BOMTable(1,k) = ItemSelection.Item(i).PartNumber
BOMTable(2,k) = ItemSelection.Item(i).Value.Name
MsgBox BOMTable(1,k)
Next
What I do wrong?
You need to select Products if you want instance-ness.
So...
InputObjectType(0) = "Product"
...
sInstanceName = ItemSelection.Item(i).Value.Name
What happens when someone selects an Assembly/Sub-Assembly? Nothing different because Sub-Assemblies have instance names too.
However, if you want to include ONLY actual CATParts, then you have to filter value post-selection something like...
Dim oInstProd as product
set oInstProd = ItemSelection.Item(i).Value
if TypeName(oInstProd.ReferenceProduct.Parent) = "PartDocument" Then
.... do stuff with only parts...
end If
The ReferenceProduct property will give you trouble if you use cache mode (it will throw an error). But their is a workaround for that if you need it.
I have a form with multiple list boxes and all work fine save 1! This is the only list box whose source is number data-type. I know this shouldn't matter, but what I'm seeing is that for this list box only the variant returned is always 1, and I cannot understand why the others (data-type text) work properly and this one doesn't. All of my Google searches and MSN searches and here on StackOverflow have not helped my specific issue though there's a LOT out there about ListBoxes. Please help!
Edit: Sorry #Mat's Mug...I was hoping that wouldn't be necessary as it's lengthy with all the checking going on, but here's the gist.
For Each ctl In Form.Controls
With ctl
Select Case .ControlType
Case acListBox
If .Visible = True Then
.SetFocus
ItemCount = .ItemsSelected.Count
If .ItemsSelected.Count > 0 Then
For Each varItm In .ItemsSelected
If .Name = "lstRating" Then
sWhereClause = sWhereClause & "ThisRating=" & .ItemData(varItem) & " Or ThatRating = " & .ItemData(varItem)
Else
sWhereClause = sWhereClause & Mid(.Name, 4, Len(.Name)) & " = """ & .ItemData(varItm) & """"
End If
Next varItm
End If
End If
End Select
End With
Next ctl
Note: When .Name = "lstRating" is True is the line where varItem returned is 1 regardless of what is selected. The list box is populated with values from 1 to 5 in 0.5 increments.
Well, I can't believe I was overlooking it for hours...I was using varItem in the offending line when it's defined at varItm, no "e"! TOTALLY an oversight on my part. Thanks all for looking into this!
I have an Excel sheet with almost 30.000 words in column A and I want to create a macro to search each word in Google Translate, get their meaning (or translation), put the meaing in column B (or if there is more than more meaning in column C, column D, etc.)
Since I have almost 30.000 words, it is a very time consuming thing to search for each word by myself. It would be great if I can do this with a macro.
Any suggestions? (Google Translate is not a "must" for me. If there is another web-site or some other way to do this, I am open to suggestions)
Note: I came across with this topic, but it did not work out the way I hoped.
Since the Google Translate API is not the free service it's tricker to perform this operation. However, I found a workaround on this page Translate text using vba and I made some adjustments so it could work for your purposes. Assuming that the original words are entered into the "A" column in the spreadsheet and translations should appear in the colums on the right here is the code:
Sub test()
Dim s As String
Dim detailed_translation_results, basic_translation_results
Dim cell As Range
For Each cell In Intersect(ActiveSheet.Range("A:A"), ActiveSheet.UsedRange)
If cell.Value <> "" Then
detailed_translation_results = detailed_translation(cell.Value)
'Check whether detailed_translation_results is an array value. If yes, each detailed translation is entered into separate column, if not, basic translation is entered into the next column on the right
On Error Resume Next
ActiveSheet.Range(cell.Offset(0, 1), cell.Offset(0, UBound(detailed_translation_results) + 1)).Value = detailed_translation_results
If Err.Number <> 0 Then
cell.Offset(0, 1).Value = detailed_translation_results
End If
On Error GoTo 0
End If
Next cell
End Sub
Function detailed_translation(str)
' Tools Refrence Select Microsoft internet Control
Dim IE As Object, i As Long, j As Long
Dim inputstring As String, outputstring As String, text_to_convert As String, result_data As String, CLEAN_DATA
Dim FirstTablePosition As Long, FinalTablePosition
Set IE = CreateObject("InternetExplorer.application")
' Choose input language - Default "auto"
inputstring = "auto"
' Choose input language - Default "en"
outputstring = "en"
text_to_convert = str
'open website
IE.Visible = False
IE.navigate "http://translate.google.com/#" & inputstring & "/" & outputstring & "/" & text_to_convert
Do Until IE.ReadyState = 4
DoEvents
Loop
Application.Wait (Now + TimeValue("0:00:5"))
Do Until IE.ReadyState = 4
DoEvents
Loop
'Firstly, this function tries to extract detailed translation.
Dim TempTranslation() As String, FinalTranslation() As String
FirstTablePosition = InStr(IE.Document.getElementById("gt-lc").innerHTML, "<tbody>")
LastTablePosition = InStr(IE.Document.getElementById("gt-lc").innerHTML, "</tbody>")
On Error Resume Next
TempTranslation() = Split(Mid(IE.Document.getElementById("gt-lc").innerHTML, FirstTablePosition, LastTablePosition - FirstTablePosition), "class=""gt-baf-cell gt-baf-word-clickable"">")
ReDim FinalTranslation(0 To UBound(TempTranslation) - 1)
For j = LBound(TempTranslation) + 1 To UBound(TempTranslation)
FinalTranslation(j - 1) = Left(TempTranslation(j), InStr(TempTranslation(j), "<") - 1)
Next j
On Error GoTo 0
Dim CheckIfDetailed
'Check whether there is detailed translation available. If not - this function returns a single translation
On Error Resume Next
CheckIfDetailed = FinalTranslation(LBound(FinalTranslation))
If Err.Number <> 0 Then
CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")
For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
Next
detailed_translation = result_data
Exit Function
End If
On Error GoTo 0
IE.Quit
detailed_translation = FinalTranslation()
End Function
Please note that the code is extremly slow (due to anti-robot restrictions) and I cannot guarantee that Google will not block the script. However, it should work.
The only thing you should do is to choose languages in the places marked by the appropriate comment.
Alternatively, if you seek something faster, you can manipulate Application.Wait method (for example setting the value to 0:00:2 instead of 0:00:5) or google for Microsoft Translate.
I have a very strange problem here. Here's the code:
reqLang = "ENG"
Select Case reqLang
Case "CRO", "ENG"
'first loop -------------------------------------
On Error GoTo reqLangVisible
i = 1
'Loop until ccCROENG's are all hidden and then go to reqLangVisible.
Do
ActiveDocument.SelectContentControlsByTag("ccCROENG")(i) _
.Range.Font.Hidden = True 'hides all CCs
i = i + 1
Loop
reqLangVisible:
'second loop -------------------------------------
On Error GoTo langOut
i = 1
'Loop until ccreqLang's are all visible and then go to langOut.
Do
ActiveDocument.SelectContentControlsByTitle("cc" & reqLang)(i) _
.Range.Font.Hidden = False 'activates reqLang CCs
i = i + 1
Loop ' CAN'T GET OUT -----------------------------------
Case "CROENG"
i = 1
'Loop until ccCROENG's are all visible and then go to langOut.
Do
On Error GoTo langOut
ActiveDocument.SelectContentControlsByTag("ccCROENG")(i) _
.Range.Font.Hidden = False 'Shows all CCs
i = i + 1
Loop
End Select
langOut:
MsgBox "Success!" '------- yeah, not really.
Stop
I hope it's clear enough what it's trying to do (at least programming-wise). I have multiple ContentControls(CCs) with same titles and tags. The problem I end up with is marked with CAN'T GET OUT, because, you guessed it - I can't get of this second loop! I end up with the Out of range error because it runs out of CCs.
What's even weirder is that it actually did get out of the first loop which has the exact same On Error statement, thought pointing to a different section.
Is it me, or did I just - however unlikely - run onto a bug in VBA?
In any case, is there a solution or at least a workaround?
Typically you only use error handling for dealing with unexpected or unpredictable situations, such as not being able to access a drive, or finding you have no network access.
Error handling is not intended as a substitute for reasonable checks which could otherwise be done. i.e. collections have a Count property which you can use when looping over their items, so avoiding any error caused by trying to access Item(n+1) when there are only n items (and here you know n from Count). Alternatively, use a For Each loop.
Here's some sample code demonstrating use of two methods for looping over your controls:
Sub Tester()
Dim cc1 As ContentControls, cc2 As ContentControls
Dim c, i As Long
With ActiveDocument
Set cc1 = .SelectContentControlsByTag("tbTag")
Set cc2 = .SelectContentControlsByTitle("tbTitle")
End With
Debug.Print "cc1 has " & cc1.Count
Debug.Print "cc2 has " & cc2.Count
'use the Count property
For i = 1 To cc1.Count
Set c = cc1(i)
c.Range.Font.Hidden = True
Next i
'use a For Each loop
For Each c In cc2
c.Range.Font.Hidden = False
Next c
End Sub
This is the type of scenario for which this type of flow control is designed.
Applied to your original code:
Sub Tester2()
Dim reqLang, cc As ContentControls, c
reqLang = "ENG"
Select Case reqLang
Case "CRO", "ENG"
Set cc = ActiveDocument.SelectContentControlsByTag("ccCROENG")
SetTextHidden cc, True
Set cc = ActiveDocument.SelectContentControlsByTitle("cc" & reqLang)
SetTextHidden cc, False
Case "CROENG"
Set cc = ActiveDocument.SelectContentControlsByTag("ccCROENG")
SetTextHidden cc, False
End Select
MsgBox "Success!" '-- yeah really
End Sub
Sub SetTextHidden(cc As ContentControls, MakeHidden As Boolean)
Dim c
For Each c In cc
c.Range.Font.Hidden = MakeHidden
Next c
End Sub
So if you've read my comment, and to formally answer your question, it is not a bug.
You just need to use Error Handling Routines correctly.
What you're trying to do is somewhat like below. HTH.
Select Case reqlang
Case "CRO", "ENG"
On Error Resume Next '~~> ignores the error when encountered
'~~> Your loop which possibly creates the error goes here
On Error Goto 0 '~~> resets the actively triggered error handling
Case "CROENG"
On Error Resume Next '~~> ignores the error when encountered
'~~> Your loop which possibly creates the error goes here
On Error Goto 0 '~~> resets the actively triggered error handling
End Select
MsgBox "Success"
But as the link suggest, you need to handle errors and not simply disregard them. Try cheking on the actual error and find a way to correct it or avoid it.
You'll be surprise that you won't even be needing the Error Handling Routine.
I'm very new with VBA Excel and i only know the things as far as i need for this report formatting task.
I'm almost done with my task but when i run the program and start the progress, eventhough it works successfully, GUI is not responding for a minute. I share my code here, is something wrong with it? Can you suggest me any best-practice? I don't want it to freeze because it will look bad to my manager.
Just to make it clear, by "not responding" i mean it freezes on the screen and says "Not Responding" on it's windows frame and when i click on it, it gives a message like this:
*ps: the sheet that i get records has 20997 rows and 7 columns and i make some records to another sheet on same file sized and 20997 lines 23 columns. And my GUI is very simple, it has nothing but a CommandButton that starts the progress.
How can i fix this?
You can prevent the freezing of excel window by putting
DoEvents
inside your loop.
This happens because your procedure is very busy working. For example your Sub TheLoop() is accessing 20995 x 16 times a cell to write on them a string. The interaction VBA with Excel is slow.
There is a couple of things you can do to make the procedure faster.
1.Disable events handlers, screen updating and calculations before you run your procedure. At the end of the procedure restore the settings again.
'Disable'
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'...... Code'
'Enable'
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
2.You can optimize the Sub TheLoop. Instead of writing immediately on the cells, write the values inside an array. After the array is full with the values, assign the values of the array to the range that you need.
for example:
Dim ResultValues() As String
Dim j As Long
ReDim ResultValues(2 To 20997, 1 To 3)
For j = 2 To 20997
ResultValues(j, 1) = "New Defect"
ResultValues(j, 2) = "3"
ResultValues(j, 3) = "2"
Next j
With ThisWorkbook.Worksheets("myWorksheet")
.Range(.Cells(2, 3), .Cells(20997, 5)) = ResultValues
End With
EDIT:
Given that the columns between the ones that you modify are only text or empty cells, you can:
read the whole range into an array.
Then modify the array in the same way you are currently modifying cells.
After the modifications are done, dump the whole matrix in the range again.'
For example:
Sub TheLoop()
Dim arrRangeValues() as Variant
Dim j as Long
arrRangeValues= Range("A2:V20997").Value2
For j = 2 To 20997
arrRangeValues(j, 1) = "Defect" 'Cells(row_index , column_index)'
arrRangeValues(j, 3) = "New Defect"
arrRangeValues(j, 4) = "3" ' this one also might be empty'
arrRangeValues(j, 5) = "2" ' this one also might be empty'
arrRangeValues(j, 7) = "Name Surname"
arrRangeValues(j, 8) = arrRangeValues(j, 7)
arrRangeValues(j, 16) = arrRangeValues(j, 7)
...
arrRangeValues(j, 10) = " http://SERVER_NAME:8888/PROJECT_NAME/ "
Next j
Range("A2:V20997").Value2 = arrRangeValues
End Sub
Alright, i believe i found the best solution for this. (a) :)
Instead of using for loop in TheLoop subroutine, i removed the loop and changed it as in below. That makes it incredibly faster when i compare it with my first code eventhough i didn't disable event properties, and now it's not freezing.
Sub TheLoop()
Cells(2, 1).Resize(20996) = "Defect"
Cells(2, 3).Resize(20996) = "New Defect"
Cells(2, 4).Resize(20996) = "3"
Cells(2, 5).Resize(20996) = "2"
Cells(2, 7).Resize(20996) = "Name Surname"
Cells(2, 8).Resize(20996) = "Name Surname"
Cells(2, 9).Resize(20996) = "FALSE"
Cells(2, 10).Resize(20996) = " http://SERVER_NAME:8888/PROJECT_NAME/ "
Cells(2, 12).Resize(20996) = "Software Quality"
Cells(2, 13).Resize(20996) = "Unsigned"
Cells(2, 14).Resize(20996) = "Software Quality"
Cells(2, 15).Resize(20996) = "1"
Cells(2, 16).Resize(20996) = "Name Surname"
Cells(2, 18).Resize(20996) = "Software Quality"
Cells(2, 20).Resize(20996) = "Development"
Cells(2, 22).Resize(20996) = " TYPE YOUR MODULE'S NAME TO HERE"
End Sub
I been tried with the Application.ScreenUpdating, Application.EnableEvents, Application.Calculation, DoEvents and Application.Wait (Now + TimeValue("0:00:10")), and unfortunately the lasted options can not to resolve that problem, looking at the Microsoft WebPage say me if a program say me "Not Responding" is
For Security reasons and
Because is too heavy or complicated
Because the program don´t sent any FeedBack to user about to do.
In my case I tried showing and MsgBox to user with the finality to provide a FeedBack for the Win10 operative system and the customer, but is so boring that the user click yes, yes, yes, yes, ok, ok, ok, ok and viewing on others forums about VBA for MsgBox (automatly close), they suggest me that code CreateObject("WScript.Shell").PopUp "Please Wait", 1 and tada!! I going to stop see the "Not Responding Message", and if the user don´t to press any click or button for disable the message don´t worry the program going to execute after the message close after 1 second in my case this solve me a lot of problems, i hope to help you, good lucky.