I'm getting a error mesage when I run this code.
Dim usf as object
If usfOKNAR01.Visible = True Then
k = 1
Set usf = VBA.UserForms(usfOKNAR01) 'here I'm getting the error
ElseIf usfOKNAR02.Visible = True Then
k = 2
Set usf = VBA.UserForms(usfOKNAR02) 'here I'm getting the error mesage
End If
I want to create a dynamic object control which is reffering to 2 Userforms called usfOKNAR01 and usfOKNAR02.
Depending which is visible the proper will be set and then used like this usf.Controls("txt" & k & "oknar13").Value in other part of my code.
I don't know where the issue can be?
Thank you for your help!
I have removed a part of my code and it seems to work but I don't know if this is the proper way to solve my issue.
Here the new code:
Dim usf as object
If usfOKNAR01.Visible = True Then
k = 1 Set
usf = usfOKNAR01
ElseIf usfOKNAR02.Visible = True Then
k = 2 Set
usf = usfOKNAR02
End If
You can't use the name or the class name as an index to VBA.UserForms - it only accepts Integer index arguments. If you don't know the integer index of the collection, you'll have to iterate over it:
Dim usf As Object
Dim found As Boolean
If usfOKNAR01.Visible = True Then
k = 1
Dim candidate As Object
For Each candidate In VBA.UserForms
If TypeOf candidate Is usfOKNAR01 Then
found = True
Exit For
End If
Next usf
If found Then Set usf = candidate
'...
Since you need to do this at least twice, I'd recommend extracting it to a function.
Note that if either of the forms is not loaded when your code runs, VBA will instantiate them when you test whether they are Visible.
Related
Does anyone know a method to sort Visio pages alphabetically using VBA?
I looked to see if a method such as vzdVisioDocument.Pages.Sort exists, but found nothing in documentation or through internet searches.
Do I need to write my own sorting function using the Application.ActiveDocument.Pages.ItemU("Page Name").Index property? That seems to be the method suggested by recording a macro of the action.
So that wasn't as painful as expected. With vzdVisioDocument as an already defined Visio.Document:
' Make a collection of titles to iterate through
Dim colPageTitles As Collection
Set colPageTitles = New Collection
Dim intPageCounter As Integer
For intPageCounter = 1 To vzdVisioDocument.Pages.Count
colPageTitles.Add vzdVisioDocument.Pages.Item(intPageCounter).Name
Next intPageCounter
' For each title in the collection, iterate through pages and find the appropriate new index
Dim intPageIndex As Integer
Dim varPageTitle As Variant
For Each varPageTitle In colPageTitles
For intPageIndex = 1 To vzdVisioDocument.Pages.Count
' Check to see if the title comes before the index's current page title
If StrComp(varPageTitle, vzdVisioDocument.Pages.Item(intPageIndex).Name) < 0 Then
' If so, set the new page index
vzdVisioDocument.Pages.ItemU(varPageTitle).Index = intPageIndex
Exit For
End If
Next intPageIndex
Next varPageTitle
' Clean up
Set colPageTitles = Nothing
I mentioned this in another comment, but when I made some test pages, it was always shuffling the pages around when I ran it because I the way that this is implemented, I don't believe that Exit For should be in there.
I also swapped the comparison to StrCompare due to personal preference along with the order of the for loops.
Sub PageSort()
Dim titlesColl As Collection
Set titlesColl = New Collection
Dim i As Long
For i = 1 To ActiveDocument.Pages.Count
titlesColl.Add ActiveDocument.Pages.Item(i).Name
Next i
Dim title As Variant
For i = 1 To ActiveDocument.Pages.Count
For Each title In titlesColl
If StrComp(ActiveDocument.Pages.Item(i).Name, title, vbTextCompare) < 0 Then
ActiveDocument.Pages.Item(title).index = i
End If
Next title
Next i
Set titlesColl = Nothing
End Sub
Private Sub reorderPages()
Dim PageNameU() As String
Dim isBackgroundPage As Boolean
Dim vsoPage As Visio.Page
Dim vsoCellObj As Visio.Cell
'// Get All Pages
Dim i As Integer
For Each vsoPage In ActiveDocument.Pages
i = i + 1
ReDim Preserve PageNameU(i)
PageNameU(i) = vsoPage.NameU
Next vsoPage
For i = 1 To UBound(PageNameU)
Set vsoPage = vsoPages.ItemU(PageNameU(i))
Set vsoCellObj = vsoPage.PageSheet.Cells("UIVisibility")
isBackgroundPage = vsoPage.Background
'// Make foreground page to set page index
If isBackgroundPage = True Then
vsoCellObj.FormulaU = visUIVNormal
vsoPage.Background = False
End If
vsoPage.Index = NumNonAppSysPages + i
'// Set to background page
If isBackgroundPage = True Then
vsoCellObj.FormulaU = visUIVHidden
vsoPage.Background = True
End If
Next i
End Sub
I have a sub that creates a Collection and adds Collections inside it. But I get an Wrong number of arguments or invalid property assignment error when adding a first collection in the loop:
Sub testState()
Dim stateCopy As State
Set stateCopy = New State
stateCopy.setStateName="some name"
stateCopy.storeBudgetWorkbooks
stateCopy.storeBudgetDatas 'error on this line
End Sub
Sub storeBudgetDatas() 'inside a class named State
...
Dim year As Integer
Dim i As Integer
i = 1
For year = 2014 To 2017
Set budgetWorkbook =
ExcelApp.Application.Workbooks.Open(budgetWorkbooks(i))
MsgBox ("still here") 'this message appears
allBudgetItems.Add getBudgetData(budgetWorkbook, year) 'this line is likely to cause problems
MsgBox ("and here") 'this message doesn't appear
budgetWorkbook.Close
i = i + 1
Next
End Sub
Function getBudgetData(budgetWorkbook As Workbook, year As Integer)
...
Dim budgetItems As Collection
Set budgetItems = getBudgetItems(year)
... 'setting attributes
getBudgetData = budgetItems(year)
End Function
Function getBudgetItems(year As Integer)
...
Dim resultCollection As Collection
Set resultCollection = New Collection
Dim itemCopy As Item
Dim i As Integer
For i = LBound(budgetItemNames) To UBound(budgetItemNames)
Set itemCopy = New Item
... 'setting attributes
resultCollection.Add itemCopy
Next
Set getBudgetItems = resultCollection
End Function
I'm not sure what's wrong here. getBudgetItems returns a collection. getBudgetData returns a collection as well. I tried adding/removing parenthesis but to no avail.
Figured it out. There should have been Set getBudgetData = budgetItems(year) instead of getBudgetData = budgetItems(year).
Since you haven't shown us all the relevant parts of your code, the best I can do is guess you're missing a Set:
Function getBudgetData(budgetWorkbook As Workbook, year As Integer)
...
Dim budgetItems As Collection
Set budgetItems = getBudgetItems(year)
... 'setting attributes
Set getBudgetData = budgetItems(year) ' Need Set here
End Function
Whenever i am trying to debug or run the program and if it encounters error, the VBE (Autocad) doesn't display the line where the error is, unlike in other IDEs, it used to come at that line and highlight with yellow color. Also, the scroll doesn't work. I know i should install plugins but i am unable to help myself.
Option Explicit
Sub Test()
'Declarations
'Opened Document
Dim acDocu As AcadDocument
Set acDocu = ThisDrawing.Application.ActiveDocument
'Select on screen
Dim acSelectionSet As AcadSelectionSet
Set acSelectionSet = ThisDrawing.SelectionSets.Add("SjjEffffT")
acSelectionSet.SelectOnScreen
'Manipulating in loops for finding group names having objects selected
Dim entity As AcadEntity
Dim entityhandle() As String
Dim Grp As AcadGroup
Dim groupname() As String
Dim i As Integer
i = 0
Dim j As Integer
j = 0
Dim temp As Integer
temp = 0
Dim GrpEnt As AcadEntity
Dim grpenthandle As String
Dim entity_count As Integer
'Dim entity_array As Variant
entity_count = acSelectionSet.Count
ReDim entityhandle(entity_count)
ReDim groupname(entity_count)
For Each entity In acSelectionSet
'entity_array = entity
entityhandle(i) = entity.Handle
For Each Grp In ThisDrawing.groups
For Each GrpEnt In Grp
grpenthandle = GrpEnt.Handle
If entityhandle(i) = grpenthandle Then
If temp = 0 Then
groupname(j) = Grp.Name
Debug.Print "Group in selection:" & groupname(j)
j = j + 1
End If
End If
temp = temp + 1
Next
temp = 0
Next
i = i + 1
Next
'Copying the objects and pasting into new drawing
Dim acDocto As AcadDocument
Dim file_name As String
'file_name = InputBox("Enter the file name along with full path and extension")
file_name = "D:\PI_Tool_files_3223\D00440023new.DWG"
Set acDocto = Documents.Open(file_name)
Dim acObject As AcadObject
Dim retvalue As Variant
retvalue = acDocu.CopyObjects(entityhandle, acDocto.ModelSpace)
acSelectionSet.Delete
End Sub
The code is written above. But i think the problem is with the add-in as i can't debug.
The VBA IDE is pretty old (1998) and it has limited debugging abilities. You should stop using this, it's an obsolete technology, not actively supported by Microsoft/Autodesk anymore.
For some errors, it is not able to locate the line where the error occurred, and you're left with obscure error codes and useless messages.
Have you tried setting a breakpoint at the first possible line? (Set acDocu = ThisDrawing.Application.ActiveDocument)
Then step through to see the offending object/property/method.
It doesn't always work.
Can you load the code into a module, instead of "ThisDrawing", then debug?
Public Sub GetStationDataFromDatabase()
Dim StationTable As New DataTable
StationTable.TableName = "Station"
Dim Counter As Integer
Dim SqlString As String
Dim OperStaRow As DataRow
Counter = 0
ProgressBar.Visible = True
ProgressBar.Minimum = 1
ProgressBar.Maximum = LocalDataSet.Tables("OR").Rows.Count
ProgressBar.Value = 1
ProgressBar.Step = 1
For Each OperStaRow In LocalDataSet.Tables("OR").Rows
SqlString = "JUST SOME STRING HERE"
ExecuteSqlCommand(SqlString, StationTable)
ProgressBar.PerformStep()
ProgressBar.Refresh()
Counter = Counter + 1
If Counter Mod 20 = 0 Then
Application.DoEvents()
End If
Next
End Sub
so, the error first happpen at progressbar.visible = True. even when i remove it, the error occur the to the line below it. can you tell me what is wrong?
and it happen when user select listbox menu. suppose i have options A and B.
i suspect that there is a typo with progressbar object name. pls check spellings. there is nothing wrong in your code.
other than that,
i suggest that you check row count > 0 before assigning progressbar maximum value.
regards
Have this line of lotusscript code in an agent that gives an "Illegal Parenthesized Reference: Items" error:
Set tempObligor.Facilities.items(Cstr(facilitydoc.requestnum(0))) = tempFacility
Facilities.items is defined as a list of objects.
So not getting why error is being thrown by the Notes 8.5 designer.
Equally odd that this worked without problem in Notes 8.0.2.
Code that makes up the objects is below.
Let me know if you have any ideas.
Believe I can do a work around by using a FOR loop that goes through all values looking for a match... but not knowing why the error is occurring bugs me...
Dim tempObligor As Obligor
'This line errs out - does not like () after .items
Set tempObligor.Facilities.items(Cstr(facilitydoc.requestnum(0))) = tempFacility
Class Obligor As CollectableObject
Public Facilities As SortableList
End Class
Class CollectableObject
' STUB
End Class
Class SortableList
Public items List As CollectableObject
Private Sub Sort()
Dim uboundarray As Integer
Dim nextTag As String
Dim x As Integer
Dim sortedArray As Variant
Dim ArrayToSort() As Variant
uboundArray = 0
Forall elem In items
NextTag = Listtag(elem)
Redim Preserve ArrayToSort(uboundArray)
ArrayToSort(uboundArray) = NextTag
uboundArray = uboundArray + 1
End Forall
SortedArray = SortArray(ArrayToSort)
Dim TempList List As CollectableObject
For x = 0 To Ubound(SortedArray)
Set TempList(SortedArray(x)) = items(SortedArray(x))
Next
Erase items
Forall elem In TempList
Set items(Listtag(elem)) = TempList(Listtag(elem))
End Forall
Erase TempList
End Sub
Function SortArray(ArrayToSort) As Variant
Dim NumberOfElements As Integer
Dim temp As String
Dim x As Integer
Dim y As Integer
NumberOfElements = Ubound(ArrayToSort)
If NumberOfElements% = 0 Then
SortArray = ArrayToSort
Exit Function
End If
For x = 0 To (NumberOfElements)
For y = 0 To ( NumberOfElements - x - 1)
If Ucase$(ArrayToSort(y)) > Ucase$(ArrayToSort(y+1)) Then
temp = ArrayToSort(y)
ArrayToSort(y) = ArrayToSort(y+1)
ArrayToSort(y+1) = temp$
End If
Next y
Next x
SortArray = ArrayToSort
End Function
End Class
I pasted your code into a ScriptLibrary. At first I got the same error. Then I noticed that there is another error of type "Reference appears before declaration" in the class definition of class Obligor. Your class Obligor is of type CollectableObject. Domino Designer seems to have a problem with the fact that CollectableObject is referenced before it is defined. So you should place the class Obligor after that class definition and then your code should work (I had to move the first two lines in the initilize though).