I have create a Node Object:
Public value As Integer
Public marked As Boolean
Private Sub Class_Initialize()
value = 0
marked = False
End Sub
Then I tried to add some Node Objects to a Collection in a for loop:
Dim inp As Integer
Dim counter As Integer
Dim n As node
Dim arr As Collection
Sub MySub()
inp = InputBox("Insert a number: ")
For counter = 2 To inp
Set n = New node
With n
.value = counter
.marked = False
End With
arr.Add n
Next counter
End Sub
But when I try to run it it only says:
Object variable or With block variable not set (Error 91)
Why is that happening?
You're missing a line before your loop:
Set arr = New Collection
Related
Sorry but I'm a total newbie in CATScript.
But I'm looking for a solution that will provide me to check every node in my Product structure recursively.
I try to adopt the Fibonacci procedure:
Function Fib(n As Long) As Long
Dim first As Long
Dim second As Long
Dim sum As Long
Dim i As Long
first = 0
second = 1
sum = 0
If n = 0 Then
Fib = first
ElseIf n = 1 Then
Fib = second
Else
For i = 2 To n
sum = first + second
first = second
second = sum
Next i
Fib = sum
End If
End Function
with this:
Private Sub TestMain
Dim searchName As String
searchName = "SearchName"
' Start with the selected object
Dim doc As Document
Set doc = CATIA.ActiveDocument
Dim prod As Product
Set prod = doc.Product
Dim foundItem As Object
foundItem = TestMainChildren(doc.Selection.Item(1).Value, searchName)
MsgBox "Found: " & foundItem.Name
End Sub
Private Function TestMainChildren(ByRef catiaObject As Object, ByVal searchName As String) As Object
Dim item As Object
For Each item In catiaObject.Items
If item.Name = "SearchName" then
Set TestMainChildren = item
Exit For
End if
Dim catiaType As String
catiaType = TypeName(item)
If catiaType = "Product" Then
TestMainChildren item, searchName
End If
Next
End Sub
but I have no idea how to do this. Can anybody help here?
It depends on what you want, but it is often very useless to check all the instances whith a recursive loop.
what is your end goal?
i suggest you to check every instance opened :
Sub main()
Dim d As Document
For Each d In CATIA.Documents
Dim p As Product
Set p = d.Product
MsgBox (p.Name)
Next
End Sub
If you insist and really want a recursive loop :
Sub main()
Dim d As Document
Set d = CATIA.ActiveDocument
Dim p As Product
Set p = d.Product
Call RecursiveAllProducts(p) 'here your recursive starts
End Sub
Sub RecursiveAllProducts(p As Product) 'your recursive
MsgBox (p.PartNumber)
If p.Products.Count > 0 Then
For i = 1 To p.Products.Count
Dim p_ As Product
Set p_ = p.Products.Item(i)
Call RecursiveAllProducts(p_) 'you call your recursive again
Next i
End If
End Sub
Maybe this question is simple, but I couldn't find an answer by googling.
So, I've got my class WSheet. I initialize array of objects of this class in my program:
ReDim WSheets(twb.Sheets.Count)
For i = 0 To UBound(WSheets)
Set WSheets(i) = New WSheet
Next i
And then, I try to read new values and sort them by insertion sort:
For i = twb.Sheets.Count To 2 Step -1
flag = False
tsName = twb.Sheets(i).Name
twb.Sheets(i).Delete
twb.Save
CurShW = curLen - FileLen(TempFName)
curLen = FileLen(TempFName)
For j = UBound(WSheets) To 2 Step -1
If WSheets(j - 1).Weight < CurShW Then
Set WSheets(j) = WSheets(j - 1)
Else
WSheets(j).SetName (tsName)
WSheets(j).SetWeight (CurShW)
flag = True
Exit For
End If
Next j
If Not flag Then
Set WSheets(1) = New WSheet
WSheets(1).SetName (tsName)
WSheets(1).SetWeight (CurShW)
flag = False
End If
Next i
So, the problem: after I set WSheets(j) = WSheets(j - 1), wsheets(j - 1) starts to contain link to wsheets(j), so, when I change wsheets(j), Wsheets (j - 1) changes too.
Please, share how to make absolute equation in this sample?
Thank you!
PS code in WSheet class
Dim SName As String 'Name of sheet
Dim SWeight As Long 'Weight of sheet in bytes
Dim blocks() As Long 'Weights of blocks in sheet in bytes
Public Function Weight() As Long
Weight = SWeight
End Function
Public Sub SetWeight(ByVal sw As Long)
SWeight = sw
End Sub
Public Function Name() As String
Name = SName
End Function
Public Sub SetName(ByVal nm As String)
SName = nm
End Sub
edited to turn the function into a Class method
You must clone the WSheet object instead of referencing it
For instance you could add a Clone() method to your WSheet class
Function Clone() As WSheet
Dim newWSheet As WSheet
Set newWSheet = New WSheet
newWSheet.SetName SName
newWSheet.SetWeight SWeight
Set Clone = newWSheet
End Function
Then in your main code change:
Set WSheets(j) = WSheets(j - 1)
To:
Set WSheets(j) = WSheets(j - 1).Clone
I had previously asked about how to evenly distribute the items in n lists into a single list and was referred to this question: Good algorithm for combining items from N lists into one with balanced distribution?.
I made a practical example of my solution for this in VBA for Excel, since my application for this was resorting my Spotify lists which can be easily pasted into Excel for manipulation. Assumptions are that you have a headerless worksheet (wsSource) of songs with columns A, B, C representing Artist, Song, SpotifyURI respectively, a "Totals" worksheet (wsTotals) containing the sum of songs for each Artist from wsSource sorted in descending order, and a "Destination" worksheet where the new list will be created. Could I get some suggestions to improve this? I was going to get rid of the totals worksheet and have this portion done in code, but I have to go and I wanted to go ahead and put this out there. Thanks!
Sub WeaveSort()
Dim wb As Workbook
Dim wsDest As Worksheet
Dim wsSource As Worksheet
Dim wsTotals As Worksheet
Dim i As Integer
Dim iLast As Integer
Dim iDest As Integer
Dim iSource As Integer
Dim iOldRow As Integer
Dim iNewRow As Integer
Dim dDiff As Double
Dim dDiffSum As Double
Set wb = ThisWorkbook
Set wsTotals = wb.Worksheets("Totals")
Set wsSource = wb.Worksheets("Source")
Set wsDest = wb.Worksheets("Dest")
iLast = wsTotals.Range("A1").End(xlDown).Row - 1
For i = 2 To iLast
iSource = wsTotals.Range("B" & i).Value
iDest = wsDest.Range("A99999").End(xlUp).Row
If i = 2 Then
wsDest.Range("A1:C" & iSource).Value2 = wsSource.Range("A1:C" & iSource).Value2
wsSource.Range("A1:C" & iSource).Delete (xlShiftUp)
GoTo NextI
End If
dDiff = iDest / iSource
dDiffSum = 0
iNewRow = 0
For iOldRow = 1 To iSource
dDiff = iDest / iSource
dDiffSum = dDiffSum + dDiff
iNewRow = Round(dDiffSum, 0)
wsSource.Rows(iOldRow).Copy
wsDest.Rows(iNewRow).Insert xlShiftDown
iDest = iDest + 1
Next iOldRow
wsSource.Range("A1:C" & iSource).Delete (xlShiftUp)
NextI:
Next i
End Sub
Great question! I would take an object oritentated approach. Also I didn;t think it was clear what the logic was so here is my answer. Two classes and one normal module. Save these separately with the filenames ListManager.cls, List.cls, tstListManager.bas
So the ListManager.cls is this
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ListManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private mdic As Object
Public Sub Initialise(ByVal vLists As Variant)
Set mdic = VBA.CreateObject("Scripting.Dictionary")
Dim vListLoop As Variant
For Each vListLoop In vLists
Dim oList As List
Set oList = New List
oList.Initialise vListLoop, ""
mdic.Add mdic.Count, oList
Next
End Sub
Public Function WeaveSort() As Variant
Dim dicReturn As Object
Set dicReturn = VBA.CreateObject("Scripting.Dictionary")
Dim oNextList As List
Set oNextList = Me.WhichListHasLeastProgress
While oNextList.PercentageDone <= 1
Dim vListItem As Variant
vListItem = oNextList.GetListItem
dicReturn.Add dicReturn.Count, vListItem
oNextList.MoveNext
Set oNextList = Me.WhichListHasLeastProgress
Wend
Dim vItems As Variant
vItems = dicReturn.Items
'I don't like this bit
ReDim vRet(1 To dicReturn.Count, 1 To 1)
Dim lLoop As Long
For lLoop = 0 To dicReturn.Count - 1
vRet(lLoop + 1, 1) = vItems(lLoop)
Next lLoop
WeaveSort = vRet
End Function
Public Function WhichListHasLeastProgress() As List
Dim vKeyLoop As Variant
Dim oListLoop As List
Dim oLeastProgress As List
For Each vKeyLoop In mdic.keys
Set oListLoop = mdic.Item(vKeyLoop)
If oLeastProgress Is Nothing Then
'nothing to compare yet
Set oLeastProgress = oListLoop
Else
If oListLoop.PercentageDone < oLeastProgress.PercentageDone Then
'definitely take this new candidate
Set oLeastProgress = oListLoop
ElseIf oListLoop.PercentageDone = oLeastProgress.PercentageDone And oListLoop.Size > oListLoop.Size Then
'close thing, both showing equal progress but we should give it to the one with the bigger "queue"
Set oLeastProgress = oListLoop
Else
'no swap
End If
End If
Next
'return the answer
Set WhichListHasLeastProgress = oLeastProgress
End Function
and the List.cls file is
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "List"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private mvList As Variant
Private mlCount As Long
Private mlCursor As Long
Private mvName As Variant
Public Function Initialise(ByRef vList As Variant, ByVal vName As Variant)
Debug.Assert TypeName(vList(1, 1)) <> "" ' this will break unless you specify a 2d array
Debug.Assert LBound(vList, 1) = 1 ' this ensure you got it from a sheet
mvList = vList
mlCount = UBound(mvList)
mlCursor = 1
mvName = vName
End Function
Public Function GetListItem()
GetListItem = mvList(mlCursor, 1)
End Function
Public Function Name() As Variant
Name = mvName
End Function
Public Function MoveNext() As Boolean
mlCursor = mlCursor + 1
MoveNext = (mlCursor < mlCount)
End Function
Public Function Size() As Long
Size = mlCount
End Function
Public Function PercentageDone() As Double
PercentageDone = mlCursor / mlCount
End Function
The last file is this tstListManager.bas
Attribute VB_Name = "tstListManager"
Option Explicit
Sub test()
Dim oListMan As ListManager
Set oListMan = New ListManager
Dim vLists As Variant
vLists = VBA.Array(ThisWorkbook.Sheets("Source").Range("A1:A3").Value2, _
ThisWorkbook.Sheets("Source").Range("B1:B2").Value2, _
ThisWorkbook.Sheets("Source").Range("C1:C5").Value2)
oListMan.Initialise vLists
Dim vSorted As Variant
vSorted = oListMan.WeaveSort
Dim lTotal As Long
ThisWorkbook.Sheets("Dest").Range("A1").Resize(UBound(vSorted, 1)).Value2 = vSorted
End Sub
Finally, the test data was in A1:A3 B1:B2 C1:C5
You should note I have abstracted away any Excel reading/writing logic and the pure weavesort logic is not cluttered.
Feel free to reject outright. Object orientation can be quite controversial and we think differently. :)
I kept receiving Object Variable Not Set (Error 91) with the following code in PowerPoint 2013.
I did a step through with this, and it flagged it on the Set SlideCounter = New Counter line which is quite confusing.
Module - Module1:
Dim SlideCounter As Counter
Sub showNext()
If SlideCounter Is Nothing Then
Set SlideCounter = New Counter
End If
ActivePresentation.SlideShowWindow.View.GotoSlide (SlideCounter.GetSlideNumber)
End Sub
Class Module - Counter:
'You should config the following constants
Const kBeginSlide As Integer = 2
Const kEndSlide As Integer = 4
Const kEnddingSlide As Integer = 5
'You should NOT modify anything below
Dim slides As Collection
Private Sub Class_Initialize()
Dim x As Integer
For x = kBeginSlide To kEndSlide
slides.Add (x)
Next x
End Sub
Public Function GetSlideNumber()
If slides.Count = 0 Then
GetSlideNumber = kEnddingSlide
Else
Dim slideIndex As Integer
slideIndex = GetRandomInteger(1, slides.Count)
GetSlideNumber = slides.Item(slideIndex)
slides.Remove (slideIndex)
End If
End Function
Private Function GetRandomInteger(lowerBound As Integer, upperBound As Integer)
Randomize
GetRandomInteger = Int((upperBound - lowerBound + 1) * Rnd + lowerBound)
End Function
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).