I am trying to get the text/label of a child node of a javatree NOT the index.
How do i do that in UFT ?
My Java tree is as below
Code that i have tried :
Dim itemsCount
Dim nodeName
Dim myText
Dim selectItem()
Dim ProgramName
ProgramName = "17030-3 Parameter, programming"
itemsCount = CInt(WpfWindow("Tech Tool").JavaWindow("Program_ECU").JavaTree("Program_Control_Unit").GetROProperty("items count"))
Redim selectItem(itemsCount)
Set objItem = WpfWindow("Tech Tool").JavaWindow("Program_ECU").JavaTree("Program_Control_Unit").Object
For i = 0 To itemsCount-1
'selectItem(i)=WpfWindow("Tech Tool").JavaWindow("Program_ECU").JavaTree("Program_Control_Unit").GetItem(i)
selectItem(i)=WpfWindow("Tech Tool").JavaWindow("Program_ECU").JavaTree("Program_Control_Unit").Select ("#0;#"&i)
If Trim(CStr(ProgramName)) = Trim(CStr(objItem.getItem(i))) Then
objItem.Select(i)
msgbox "Success"
End If
Next
I have also tried using .GetColumnValue("#0;#1") but that also did not work
Traversing JTree in UFT is complicated than it should be. Here is what I did when I had to traverse through a JTree
Set JTree = WpfWindow("Tech Tool").JavaWindow("Program_ECU").JavaTree("Program_Control_Unit").Object
'return how many nodes there are in the tree irrespective of their level
MsgBox JTree.getRowCount
Set JModel = JTree.getModel 'get jtree data model
Set JRoot = JModel.getRoot 'get root so that we can traverse the tree
Call JTreeWalk(JModel, JRoot)
'recursively traverse the jtree
Sub JTreeWalk(JModel, objNode)
ctr = JModel.getChildCount(objNode)
For i = 0 To ctr - 1
Set objChild = JModel.getChild(objNode, i)
If JModel.isLeaf(objChild) Then
Print vbTab & objChild.toString
Else
Print "~~ " & objChild.toString & " ~~"
End If
Call JTreeWalk(JModel, objChild)
Next
End Sub
Useful links
https://docs.oracle.com/javase/tutorial/uiswing/components/tree.html
http://www.rgagnon.com/javadetails/java-0313.html (I used this java code and converted into vbs)
Related
Recently I've encountered a rather odd dictionary behaviour.
Sub DictTest()
Dim iDict As Object
Dim i As Integer
Dim strArr() As String
Set iDict = CreateObject("Scripting.Dictionary")
strArr = Split("Why does this happen ? Why does this happen over and over ?", " ")
For i = LBound(strArr) To UBound(strArr)
iDict(strArr(i)) = strArr(i)
Next
End Sub
The output is iDict populated with 7 items:
But whenever I add watch:
It adds an empty item to a dictionary:
Why does adding a watch expression create an empty item in the dictionary?
If you examine the entry in the dictionary with a key of "What???" then naturally an entry must be created in the dictionary in order to show you that entry.
If you want to just check whether an entry exists, then perform a watch on iDict.Exists("What???").
Adding a watch is operating no differently to the following code:
Sub DictTest()
Dim iDict As Object
Dim i As Integer
Dim strArr() As String
Set iDict = CreateObject("Scripting.Dictionary")
strArr = Split("Why does this happen ? Why does this happen over and over ?", " ")
For i = LBound(strArr) To UBound(strArr)
iDict(strArr(i)) = strArr(i)
Next
MsgBox "The value of the 'What???' entry in iDict is '" & iDict("What???") & "'"
End Sub
This changing of the contents of a Dictionary object is no different to using the Watch Window to change the value of x in the following situation:
In the above code, I used the watch window to edit the value of x from 5 to 10 prior to the Debug.Print statement.
I'm trying to call excel's FORECAST.ETS from VBA in my access project but it seems like no matter what I do I get this error:
"VBA Error 1004 Invalid number of arguments."
Here's what I'm doing -
'**********************************************
Public Sub testFCsof()
Dim testrfXL As Object
Dim testrfNowDate As Date
Dim testrfempSQLStr As String
Dim testrfempSQLRS As DAO.Recordset
Dim testrfRecNo As Integer
Dim testrfDateARRAY() As Date
Dim testrfPointsARRAY() As Double
Dim testrfFDFCAST As Double
Dim fdtestempID As Long
On Error GoTo Err_testrfNBA
Set todaysDB = CurrentDb()
fdtestempID = 382
testrfFDFCAST = 1000000
testrfempSQLStr = "SELECT NBAFANempPER.eventTime, NBAFANempPER.FDpoints " & _
"FROM NBAFANempPER WHERE ((NBAFANempPER.empID)= " & fdtestempID & ") ORDER BY NBAFANempPER.eventTime;"
Set testrfempSQLRS = todaysDB.OpenRecordset(testrfempSQLStr, dbOpenDynaset, dbSeeChanges, dbReadOnly)
If Not (testrfempSQLRS.BOF And testrfempSQLRS.EOF) Then 'only do this if we have records
testrfempSQLRS.MoveLast
ReDim testrfDateARRAY(testrfempSQLRS.RecordCount - 1)
ReDim testrfPointsARRAY(testrfempSQLRS.RecordCount - 1)
testrfempSQLRS.MoveFirst
testrfRecNo = 0
Do While Not testrfempSQLRS.EOF
testrfDateARRAY(testrfRecNo) = CDate(dateHeadFunk(CDate(testrfempSQLRS!eventTime)))
testrfPointsARRAY(testrfRecNo) = CDbl(testrfempSQLRS!FDpoints)
testrfRecNo = testrfRecNo + 1
testrfempSQLRS.MoveNext
Loop
Set testrfXL = CreateObject("Excel.Application")
testrfNowDate = Now()
testrfFDFCAST = testrfXL.WorksheetFunction.Forecast.ets(Arg1:=testrfNowDate, Arg2:=testrfPointsARRAY, Arg3:=testrfDateARRAY, Arg4:=0, Arg5:=1, Arg6:=5)
Set testrfXL = Nothing
End If
Exit_testrfNBA:
Erase testrfPointsARRAY
Erase testrfDateARRAY
testrfNowDate = Empty
testrfempSQLStr = ""
If Not testrfempSQLRS Is Nothing Then
testrfempSQLRS.Close
Set testrfempSQLRS = Nothing
End If
Exit Sub
Err_testrfNBA:
MsgBox "Got a sucky forecast number back.."
generic.TestODBCErr
Resume Exit_testrfNBA
End Sub
'**********************************************
The arrays fill up just fine, both the same size.
I can call other Excel functions without a problem.
Can't figure out what the problem could be. I've tried this with and without the "Arg=" tags, with and without the last three optional arguments, tried wrapping the arrays with Array(myArray), even set the Arrays to Variant.
At least in Excel VBA, the function name is Forecast_ETS, not Forecast.ETS.
I am trying to feed data from an Excel sheet array (Udaje) to populate a several word documents from a template (hence the For in the example). I would like to insert some of the data to several Content Controls (text) at the same time. I am calling them by Tags and I know that I have to specify by adding .Item() - but then I only update one of the Content Controls.
Is there any way to overcome this restriction? I was thinking about cycling the tags with for but it seems to be a bit clumsy as I do not know how many tags I have to go through. I am a beginner at the VBA.
Or should I be using bookmarks instead?
For i = 1 To LastRow
'.SelectContentControlsByTag("NapRozhodnuti").Item(1).Range.Text = Udaje(i, 4)
.SelectContentControlsByTag("ZeDne").Item(1).Range.Text = Udaje(i, 5)
.SelectContentControlsByTag("NapadRozkladu").Item(1).Range.Text = Udaje(i, 6)
.SelectContentControlsByTag("Ucastnik").Item(1).Range.Text = Udaje(i, 2)
.SelectContentControlsByTag("DatumRK").Item(1).Range.Text = DatumRK
.SelectContentControlsByTag("NavrhRK").Item(1).Range.Text = NavrhRK
.SelectContentControlsByTag("OblastRK").Item(1).Range.Text = OblastRK
.SelectContentControlsByTag("Tajemnik").Item(1).Range.Text = Tajemnik
.SelectContentControlsByTag("Gender").Item(1).Range.Text = Gender
.SaveAs2 Filename:= i & " - dokumenty_k_RK.docx", _
FileFormat:=wdFormatDocument
Next i
Edit: the solution I chose in the end was to go through CCs in the document according to their Index number and set the value of each CC according to its tag:
For i = 1 To LastRow
For y = 1 To CCNumber
Select Case .ContentControls(y).Tag
Case "NapRozhodnuti"
.ContentControls(y).Range.Text = Udaje(i, 4)
Case "ZeDne"
.ContentControls(y).Range.Text = Udaje(i, 5)
Case "NapadRozkladu"
.ContentControls(y).Range.Text = Udaje(i, 6)
Case "Ucastnik"
.ContentControls(y).Range.Text = Udaje(i, 2)
Case "DatumRK"
.ContentControls(y).Range.Text = DatumRK
Case "NavrhRK"
.ContentControls(y).Range.Text = NavrhRK
Case "OblastRK"
.ContentControls(y).Range.Text = OblastRK
Case "Tajemnik"
.ContentControls(y).Range.Text = Tajemnik
Case "Gender"
.ContentControls(y).Range.Text = Gender
End Select
Next y
.SaveAs2 Filename:="..." & i & " - dokumenty_k_RK.docx", _
FileFormat:=wdFormatDocument
Next i
Edit: loop code
...
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Open "\\fs1\homes\rostislav.janda\Documents\320\pozvanka_prazdna.docx"
With objWord.ActiveDocument
Set ccs = .SelectContentControlsByTag("Spznrozkladu")
LoopCCs ccs, Udaje(i, 1)
.SaveAs2 Filename:="\\fs1\homes\rostislav.janda\Documents\320\výstup\pozvanka.docx", _
FileFormat:=wdFormatDocument 'uloží s formátem .docx
.Saved = True
End With
objWord.Quit
Set objWord = Nothing
End Sub
*Sub LoopCCs(ccs As Word.ContentControls, val As String)*
Dim cc As Word.ContentControl
For Each cc In ccs
cc.Range.Text = val
Next cc
End Sub
The Suprocedure declaration line is where the error ocurres.
Even though you've already found an approach that works for you, here's a tip that bases on the starting point you provide in your Question. You're using SelectContentControlsByTag, then only addressing the first of the controls found, using .Item(1).
This method returns an array of content controls and you don't have to know, going in, how many: you can use a For Each loop to cycle through as many as there are in the array. And so that you don't need to repeat the code of the loop for each tag, put that in a separate procedure, passing the array plus the value to be assigned to content controls with the same tag to it.
So something like this:
With doc
'Like this
Set ccs = .SelectContentControlsByTag("test")
LoopCCs ccs, Udaje(i, 4)
'Or like this
LoopCCs .SelectContentControlsByTag("ZeDne"), Udaje(i, 5)
End With
'Code is VBA and demonstrates the Word object model data types
'For VBS don't declare as types or type as Object
Sub LoopCCs(ccs as Word.ContentControls, val as String)
Dim cc as Word.ContentControl
For Each cc In ccs
cc.Range.Text = val
Next cc
End Sub
To do it using the Custom XML Part way, you could use the following code. As it stands, it needs to be in a single module.
You would use replaceAndLinkCxp to create/recreate the necessary Custom XML Part (i.e. it's a one off).
You would use linkedTaggedCcsToCxps to link/relink your Tagged content controls to the correct Cxp/Element (also a one-off). To work with the document, it would probably be simpler to create a Content Control for each tag, connect them using this routine, then create an autotext for the control.
You would use something based on populateCxpData to put the data in your Cxp.
There are quite a few assumptions (e.g. all the content controls are plain text, Element names are the same as tag names) and plenty of scope for improvement.
' This should be a name that belongs to you/your organisation
' It should also be unique for each different XML part structure
' you create. i.e. if you have one XML part with elements a,b,c
' and another with elements a,b,d, give them different namespace
' names.
Const sNameSpace = "hirulau"
' Specify the root element name for the part
Const sRootElementName = "ccdata"
Sub replaceAndLinkCxp()
' This deletes any existing CXP with the namespace specified
' in sOldNamespace, and creates a new CXP with the namespace
' in sNamespace. Any data in the CXP is lost.
' Then it links each Content Control with a tag name
' the same as an Element name in the part
' The old namespace (can be the same as the new one)
Const sOldNamespace = "hirulau"
Dim cc As Word.ContentControl
Dim ccs As Word.ContentControls
Dim cxp As Office.CustomXMLPart
Dim cxps As Office.CustomXMLParts
Dim i As Long
Dim s As String
' Specify the number and names of the elements and tags
' Each Element name should be unique, and a valid XML Element name
' and valid Content Control Tag Name
' (No nice way to do this in VBA - could just have a string and split it)
' NB, your CC tag names do not *have* to be the same as the XML Element
' names, but in this example we are making them that way
Dim sElementName(8) As String
sElementName(0) = "NapRozhodnuti"
sElementName(1) = "ZeDne"
sElementName(2) = "NapadRozkladu"
sElementName(3) = "Ucastnik"
sElementName(4) = "DatumRK"
sElementName(5) = "NavrhRK"
sElementName(6) = "OblastRK"
sElementName(7) = "Tajemnik"
sElementName(8) = "Gender"
' remove any existing CXPs with Namespace sOldNamespace
Set cxps = ActiveDocument.CustomXMLParts.SelectByNamespace(sOldNamespace)
For Each cxp In cxps
cxp.Delete
Next
Set cxps = Nothing
'Debug.Print ActiveDocument.CustomXMLParts.Count
' Build the XML for the part
s = "<" & sRootElementName & " xmlns=""" & sNameSpace & """>" & vbCrLf
For i = LBound(sElementName) To UBound(sElementName)
s = s & " <" & sElementName(i) & " />" & vbCrLf
Next
s = s & "</" & sRootElementName & ">"
'Debug.Print s
' Create the Part
Set cxp = ActiveDocument.CustomXMLParts.Add(s)
' For each element/tag name, find the ccs with the tag
' and connect them to the relevant element in the part
For i = LBound(sElementName) To UBound(sElementName)
For Each cc In ActiveDocument.SelectContentControlsByTag(sElementName(i))
' the "map:" is just a local mapping to the correct namespace.
' It doesn't have any meaning outside this method call.
cc.XMLMapping.SetMapping "/map:" & sRootElementName & "/map:" & sElementName(i) & "[1]", "xmlns:map=""" & sNameSpace & """", cxp
Next
Next
Set cxp = Nothing
End Sub
Sub linkTaggedCcsToCxps()
' Finds our Custom part, then relinks all controls with
' tag names that correspond to its *top level element names*
' So as long as you tag a suitable content control correctly,
' you can use this routine to make it point at the correct Cxp Element
Dim cc As Word.ContentControl
Dim cxn As Office.CustomXMLNode
Dim cxps As Office.CustomXMLParts
' Notice that we need the correct namespace name to do this
Set cxps = ActiveDocument.CustomXMLParts.SelectByNamespace(sNameSpace)
If cxps.Count = 0 Then
MsgBox "Could not find the expected Custom XML Part."
Else
' Iterate through all the *top-level* child Element nodes
For Each cxn In cxps(1).SelectNodes("/*/*")
For Each cc In ActiveDocument.SelectContentControlsByTag(cxn.BaseName)
' the "map:" is just a local mapping to the correct namespace.
' It doesn't have any meaning outside this method call.
cc.XMLMapping.SetMapping "/map:" & sRootElementName & "/map:" & cxn.BaseName & "[1]", "xmlns:map=""" & sNameSpace & """", cxps(1)
Next
Next
End If
Set cxps = Nothing
End Sub
Sub populateCxpData()
Dim sXpPrefix As String
' You would need to populate the following things
Dim i As Integer
Dim Udaje(1, 6) As String
Dim DatumRK As String
Dim NavrhRK As String
Dim OblastRK As String
Dim Tajemnik As String
Dim Gender As String
i = 1
' we need the namespace, but this time assume that we can use
' the first part with that namespace (and that it exists)
With ActiveDocument.CustomXMLParts.SelectByNamespace(sNameSpace)(1)
sXpPrefix = "/*/" & .NamespaceManager.LookupPrefix(sNameSpace) & ":"
.SelectSingleNode(sXpPrefix & "NapRozhodnuti[1]").Text = Udaje(i, 4)
.SelectSingleNode(sXpPrefix & "ZeDne[1]").Text = Udaje(i, 5)
.SelectSingleNode(sXpPrefix & "NapadRozkladu[1]").Text = Udaje(i, 6)
.SelectSingleNode(sXpPrefix & "Ucastnik[1]").Text = Udaje(i, 2)
.SelectSingleNode(sXpPrefix & "DatumRK[1]").Text = DatumRK
.SelectSingleNode(sXpPrefix & "NavrhRK[1]").Text = NavrhRK
.SelectSingleNode(sXpPrefix & "OblastRK[1]").Text = OblastRK
.SelectSingleNode(sXpPrefix & "Tajemnik[1]").Text = Tajemnik
.SelectSingleNode(sXpPrefix & "Gender[1]").Text = Gender
End With
End Sub
I need to set a parent Control to another control using the VBA code.
Actually i am looping to create differents controls dynamically and i want now to link them by child-parent.
Do someone has an idea ?
Here is the function where i create a new control and i set some values. And the last assignment is where i want to set the parent
Public Function apply_change(ihm_f, oNode, iMyName$, project$)
Dim new_elem
Dim oSubNodes As IXMLDOMNode
If oNode.Attributes.getNamedItem("Type").Text <> "Page" Then
If (oNode.Attributes.getNamedItem("Type").Text = "RefEdit") Then
Set new_elem = ihm_f.Designer.Controls.Add("RefEdit.Ctrl", oNode.nodeName, True)
Else
Set new_elem = ihm_f.Designer.Controls.Add("Forms." & oNode.Attributes.getNamedItem("Type").Text & ".1", oNode.nodeName, True)
End If
With new_elem
On Error Resume Next
.Width = oNode.Attributes.getNamedItem("Width").Text
.Top = oNode.Attributes.getNamedItem("Top").Text
.Left = oNode.Attributes.getNamedItem("Left").Text
.Height = oNode.Attributes.getNamedItem("Height").Text
Set .Parent = get_parent(oNode.ParentNode.nodeName, oNode, ihm_f)
End With
If oNode.Attributes.getNamedItem("Type").Text = "MultiPage" Then
Call new_elem.Pages.Remove(0)
Call new_elem.Pages.Remove(0)
For Each oSubNodes In oNode.ChildNodes()
Call new_elem.Pages.Add(oSubNodes.BaseName, oSubNodes.Attributes.getNamedItem("Caption").Text, oSubNodes.Attributes.getNamedItem("Index").Text)
Next oSubNodes
End If
End If
Set apply_change = ihm_f
End Function
The getparent function return a Controle which can be anything .. like textbox or combo box etc..
You provide so little information in your question that it is difficult to guess your objective.
However, I am guessing that you want to record that Control Xxxxx is the parent of control Yyyyy where the definition of “parent” has nothing to do with Excel’s definition of parent. I am further guessing you do not know how to access controls by number.
The macro below lists the name, type and top position of every control on a form by its index number within the collection Controls. Any property of a control is accessible in this way. If control Xxxxx is the parent of control Yyyyy, you can scan the collection to find their index numbers when the form loads and record this information for use when required.
Private Sub UserForm_Initialize()
Dim InxCtrl As Long
Dim LenNameMax As Long
Dim LenTypeMax As Long
LenNameMax = 0
For InxCtrl = 0 To Controls.Count - 1
If LenNameMax < Len(Controls(InxCtrl).Name) Then
LenNameMax = Len(Controls(InxCtrl).Name)
End If
If LenTypeMax < Len(TypeName(Controls(InxCtrl))) Then
LenTypeMax = Len(TypeName(Controls(InxCtrl)))
End If
Next
Debug.Print PadR("Name", LenNameMax) & "|" & PadR("Type", LenTypeMax) & "| Top"
For InxCtrl = 0 To Controls.Count - 1
Debug.Print PadR(Controls(InxCtrl).Name, LenNameMax) & "|" & _
PadR(TypeName(Controls(InxCtrl)), LenTypeMax) & "|" & _
PadL(Format(Controls(InxCtrl).Top, "#,###.00"), 8)
Next
End Sub
I'm still learning VBA and I can't figure out wth I'm having so many problems with a Collections object.
I have a function that adds custom objects (I created a very simple class to store some data) that does the typical "read data, create object representation, stick it into Collections" sort of stuff.
If I try to add a "key" to the bag.add call I get a "Compile error. Expected:=" message.
If I don't it appears to have worked then when I run the program it says "Compile Error. Argument not optional" and highlights the "getRevColumns = bag" line.
I can't for the life of me figure out wth is going on! I suspect something wrong with how I initialized my bag?! PS: columnMap is the name of my custom class.
Function getRevColumns() As Collection
Dim rng As Range
Dim i As Integer
Dim bag As Collection
Dim opManCol As Integer, siebelCol As Integer
Dim opManColName As String, siebelColName As String
Dim itm As columnMap
Set bag = New Collection
Set rng = shSiebelMap.UsedRange.Columns(5)
i = 1
For i = 1 To rng.Rows.count
If StrComp(UCase(rng.Cells(i).value), "Y") = 0 Then
opManCol = rng.Rows(i).OffSet(0, -2).value
opManColName = rng.Rows(i).OffSet(0, -4)
siebelCol = rng.Rows(i).OffSet(0, -1).value
siebelColName = rng.Rows(i).OffSet(0, -3)
Set itm = New columnMap
itm.opManColName = opManColName
itm.opManColNumber = opManCol
itm.siebelColName = siebelColName
itm.siebelColNumber = siebelCol
'WHY DOESN'T IT WORK!''
bag.Add (itm)
'MsgBox "opMan Col: " & opManColName & " : " & opManCol & ". Siebel Col: " & siebelColName & " : " & siebelCol'
End If
Next i
getRevColumns = bag
End Function
Try removing the parens around itm in the add:
bag.Add itm
or
bag.Add itm, key
It's been a while since I've had to work with VBA/VB6, but I believe including the parens causes itm to be passed by value instead of by reference. I could be wrong.
the bag is an object. Rule #1 for objects use Set
Set getRevColumns = bag
You need to say
set getRevColumns = bag
also I guess you have a problem on the add. I don't know why this is but it works on
bag.add itm
I tried the whole thing in a simple manner here is my working code
Sub myroutine()
Dim bag As Collection
Dim itm As clsSimple
Set bag = getTheCollection()
Set itm = bag.Item(1)
MsgBox (itm.someObjectValue)
Set itm = bag.Item(2)
MsgBox (itm.someObjectValue)
End Sub
Function getTheCollection() As Collection
Dim bag As Collection
Dim itm As clsSimple
Set bag = New Collection
Set itm = New clsSimple
itm.someObjectValue = "value 1"
bag.Add itm
Set itm = New clsSimple
itm.someObjectValue = "value 2"
bag.Add itm
Set getTheCollection = bag
End Function
The class is really simple:
Public someObjectValue As String
Hope it helps
I had a similar problem with a collection.
I Dim'd it but hadn't set it with New or initialized it.
Basically i had
Dim collection1 As Collection
...
collection1.Add item 'no compile error just empty
I added the following before the add
Set collection1 = New Collection
Call collection1.init
then it worked like a charm...I had also moved the Dim statement from the Sub to the top of the Module to make it a class variable