I have class sObrazac in which I have
'''<remarks/>
<System.Xml.Serialization.XmlArrayItemAttribute("Primatelji", IsNullable:=false), _
System.Xml.Serialization.XmlArrayItemAttribute("P", IsNullable:=false, NestingLevel:=1)> _
Public Property StranaB() As sPrimateljiP()()
Get
Return Me.stranaBField
End Get
Set
Me.stranaBField = value
End Set
End Property
'''<remarks/>
<System.CodeDom.Compiler.GeneratedCodeAttribute("xsd", "4.6.81.0"), _
System.SerializableAttribute(), _
System.Diagnostics.DebuggerStepThroughAttribute(), _
System.ComponentModel.DesignerCategoryAttribute("code"), _
System.Xml.Serialization.XmlTypeAttribute(AnonymousType:=true, [Namespace]:="http://e-porezna.porezna-uprava.hr/sheme/zahtjevi/ObrazacJOPPD/v1-1")> _
Partial Public Class sPrimateljiP
Private p1Field As Long
Private p2Field As String
Private p3Field As String
Private p4Field As String
.....
'''<remarks/>
Public Property P1() As Long
Get
Return Me.p1Field
End Get
Set
Me.p1Field = value
End Set
End Property
And now I'm setting the object what I have tried
Dim oPrimatelj As New sPrimateljiP
oPrimatelj.P1 = 1
oPrimatelj.P2 = 00019
oPrimatelj.P3 = 00019
oPrimatelj.P4 = 02994650199 ....
After setting that object I tried to push it into list and from it to array
Dim sList As New List(Of sPrimateljiP)
sList.Add(oPrimatelj)
oObrazac.StranaB = sList.ToArray
But as you know it will throw me
Value of type sPrimateljIP() cannot be converted to sPrimateljIP()()
I'm not quite familiar with two dimension arrays and I'm stuck here...
This may clear my question more. What is this element named P.
Note: I can't make schema, I need to adjust code to it.
Ok i found out what solution may be thanks to comment by Chetan. Use jagged array
Push list to jagged array and set it as object
Dim sList As New List(Of sPrimateljiP)
sList.Add(oPrimatelj)
sList.Add(oPrimatelj)
Dim jaggedArray()() As sPrimateljiP = New sPrimateljiP(0)() {sList.ToArray}
oObrazac.StranaB = jaggedArray
Related
I have tree classes as follows:
Public Class HtmlSection
Property Name As String
Property SubSections As List(Of HtmlSubSection)
End Class
Public Class HtmlSubSection
Property Name As String
Property SelectedSentences As List(Of HtmlSentence)
End Class
Public Class HtmlSentence
Property Sentence As String
Property Position As Integer
End Class
In below method i am searching for all sentences for each subsection belonging to specific section, at the end i sort those records by Position asc. However sometimes positions have to be changed (directly in sentences) because there could be gaps means after i do OrderBy it will be ordered but it could look like this below. Is there any easy way like linq to change that Positions of that sentences to avoid gaps let's say in the method i shown below.
2
5
77
1001
i would like to change positions starting from 0 in our example:
0
1
2
3
Method:
Public Function GetSelectedSentencesOnSectionLevel(section As HtmlSection) As List(Of HtmlSentence)
Dim sentencesList As New List(Of HtmlSentence)
For Each exSection As HtmlSection In _htmlFactory.SectionsList
If exSection.Name = section.Name Then
Dim sentencesList As New List(Of HtmlSentence)
If Not IsNothing(exSection.SubSections) Then
For Each exSubsection As HtmlSubSection In exSection.SubSections
If Not IsNothing(exSubsection.SelectedSentences) Then
For Each exSentence As HtmlSentence In exSubsection.SelectedSentences
sentencesList.Add(exSentence)
Next
End If
Next
End If
End If
Next
'sort sentences by Posiions ascending
sentencesList = sentencesList.OrderBy(Function(x) x.Position).ToList()
Return sentencesList
End Function
EDIT : more code for helpers:
global class:
Public Class HtmlFactory
Property SectionsList As List(Of HtmlSection)
Sub New()
SectionsList = New List(Of HtmlSection)
End Sub
Sub New(pSectionsList As List(Of HtmlSection))
_SectionsList = pSectionsList
End Sub
Public Sub AddSection(section As HtmlSection)
SectionsList.Add(section)
End Sub
....
Here you are a pure LINQ solution.
Dim index As Integer = -1
Dim sectionName As String
Dim allTheSections As List(Of HtmlSection)
Dim sentenceList = allTheSections _
.Where(Function(sect) _
sect.SubSections IsNot Nothing _
AndAlso sect.Name.Equals(sectionName, StringComparison.OrdinalIgnoreCase)) _
.SelectMany(Function(sect) sect.SubSections) _
.Where(Function(subSect) subSect.SelectedSentences IsNot Nothing) _
.SelectMany(Function(subSect) subSect.SelectedSentences) _
.OrderBy(Function(ss) ss.Position) _
.Select(Function(ss)
index += 1
Return New HtmlSentence With {.Position = index, .Sentence = ss.Sentence}
End Function) _
.ToList()
In this example, allTheSections is where you exSection does coming from.
I have the following class :
Public Class titlesclass
Public Property Link As String
Public Property Title As String
Public Function Clear()
Link.Distinct().ToArray()
Title.Distinct().ToArray()
End Function
End Class
And the following code :
For Each title As Match In (New Regex(pattern).Matches(content)) 'Since you are only pulling a few strings, I thought a regex would be better.
Dim letitre As New titlesclass
letitre.Link = title.Groups("Data").Value
letitre.Title = title.Groups("Dataa").Value
lestitres.Add(letitre)
'tempTitles2.Add(title.Groups("Dataa").Value)
Next
I tried to delete the duplicated strings using the simple way
Dim titles2 = lestitres.Distinct().ToArray()
And calling the class function :
lestitres.Clear()
But the both propositions didn't work , i know that i'm missing something very simple but still can't find what it is
Easier to use a class that already implements IComparable:
Dim query = From title In Regex.Matches(content, pattern).Cast(Of Match)
Select Tuple.Create(title.Groups("Data").Value, title.Groups("Dataa").Value)
For Each letitre In query.Distinct
Debug.Print(letitre.Item1 & ", " & letitre.Item2)
Next
or Anonymous Types:
Dim query = From title In Regex.Matches(content, pattern).Cast(Of Match)
Select New With {Key .Link = title.Groups("Data").Value,
Key .Title = title.Groups("Dataa").Value}
For Each letitre In query.Distinct
Debug.Print(letitre.Link & ", " & letitre.Title)
Next
Ok, Since I notice you are using a ClassHere is one option you can do in order to not add duplicate items to your List within a class.I'm using a console Application to write this example, it shouldn't be too hard to understand and convert to a Windows Form Application if need be.
Module Module1
Sub Main()
Dim titlesClass = New Titles_Class()
titlesClass.addNewTitle("myTitle") ''adds successfully
titlesClass.addNewTitle("myTitle") '' doesn't add
End Sub
Public Class Titles_Class
Private Property Title() As String
Private Property TitleArray() As List(Of String)
Public Sub New()
TitleArray = New List(Of String)()
End Sub
Public Sub addNewTitle(title As String)
Dim added = False
If Not taken(title) Then
Me.TitleArray.Add(title)
added = True
End If
Console.WriteLine(String.Format("{0}", If(added, $"{title} has been added", $"{title} already exists")))
End Sub
Private Function taken(item As String) As Boolean
Dim foundItem As Boolean = False
If Not String.IsNullOrEmpty(item) Then
foundItem = Me.TitleArray.Any(Function(c) -1 < c.IndexOf(item))
End If
Return foundItem
End Function
End Class
End Module
Another option would be to use a HashSet, It will never add a duplicate item, so even if you add an item with the same value, it wont add it and wont throw an error
Sub Main()
Dim titlesClass = New HashSet(Of String)
titlesClass.Add("myTitle") ''adds successfully
titlesClass.Add("myTitle") '' doesn't add
For Each title As String In titlesClass
Console.WriteLine(title)
Next
End Sub
With all of that aside, have you thought about using a Dictionary so that you could have the title as the key and the link as the value, that would be another way you could not have a list (dictionary) contain duplicate items
I'm new to using VBA classes, and I think what I want to do -- using them with ListObjects -- is more of an "intermediate" than "beginner" technique.
Let's say I have two tables related to cars.
tblCarDesc
ID MAKE MODEL DOORS ENGINE
1 Chevrolet Corvette 2 V8
2 Ford Escort 4 V6
3 Rolls-Royce SilverCloud 4 V8
tblCarProd
ID COUNTRY TYPE
1 US Sport
2 US Economy
3 UK Luxury
(The same cars are in both tables, and shown by the ID numbers.)
I want to have a class called objCars that includes the fields (columns) from both tables. That way, when referring to Car #3, objCars.Make would be "Rolls-Royce" and objCars.Type would be "Luxury".
1) Is there a way to import both tables into objCars?
Perhaps I would create an array big enough to hold all the columns, then load both tables into it. The tutorial I've been reading says that I would then create a Collection, loop through each row of the array, make a new instance of objCars, and assign objCars.Make, objCars.Model, etc., for each row. Then each item of the Collection would contain a car. (Or something like that. I don't really know much about Collections either.) If that's right, is it the best way?
2) How exactly does one refer to a specific car? The examples I've read like to loop through Collections and work on each item therein, but what if I want to extract a particular item? I know the Ford is Car #2; how do I get the objCars.Make and objCars.Model for that particular ID number?
I would have two classes. A class clsCar for one car and a class clsCars for a collection of cars.
Each of this classes may have setter and getter methods and also may have custom methods if needed. Especially the clsCars should have a set of getBy...-methods to get a car or a collection of cars from the collection by criterion.
Example:
clsCar:
Private pID As Long
Private pMAKE As String
Private pMODEL As String
Private pDOORS As Integer
Private pENGINE As String
Private pCOUNTRY As String
Private pTYPE As String
Public Property Get ID() As Long
ID = pID
End Property
Public Property Let ID(Value As Long)
pID = Value
End Property
Public Property Get MAKE() As String
MAKE = pMAKE
End Property
Public Property Let MAKE(Value As String)
pMAKE = Value
End Property
Public Property Get MODEL() As String
MODEL = pMODEL
End Property
Public Property Let MODEL(Value As String)
pMODEL = Value
End Property
Public Property Get DOORS() As Integer
DOORS = pDOORS
End Property
Public Property Let DOORS(Value As Integer)
pDOORS = Value
End Property
Public Property Get ENGINE() As String
ENGINE = pENGINE
End Property
Public Property Let ENGINE(Value As String)
pENGINE = Value
End Property
Public Property Get COUNTRY() As String
COUNTRY = pCOUNTRY
End Property
Public Property Let COUNTRY(Value As String)
pCOUNTRY = Value
End Property
Public Property Get CarTYPE() As String
CarTYPE = pTYPE
End Property
Public Property Let CarTYPE(Value As String)
pTYPE = Value
End Property
Public Function toString() As String
toString = pID & "; " & _
pMAKE & "; " & _
pMODEL & "; " & _
pDOORS & "; " & _
pENGINE & "; " & _
pCOUNTRY & "; " & _
pTYPE
End Function
clsCars:
Private pCars As collection
Private Sub Class_Initialize()
Set pCars = New collection
End Sub
Public Sub add(oCar As clsCar)
pCars.add oCar
End Sub
Public Function getByIndex(lIndex As Long) As clsCar
Set getByIndex = pCars.Item(lIndex)
End Function
Public Function getByID(lID As Long) As clsCar
Dim oCar As clsCar
For Each oCar In pCars
If oCar.ID = lID Then
Set getByID = oCar
End If
Next
End Function
Public Function getByEngine(sEngine As String) As collection
Dim oCar As clsCar
Set getByEngine = New collection
For Each oCar In pCars
If oCar.ENGINE = sEngine Then
getByEngine.add oCar
End If
Next
End Function
default Module:
Public oCars As clsCars
Sub initialize()
Dim oCar As clsCar
Dim oListObject As ListObject
Dim oListRow As ListRow
Dim oCells As Range
Set oCars = New clsCars
Set oListObject = Worksheets("Sheet1").ListObjects("tblCarDesc")
For Each oListRow In oListObject.ListRows
Set oCells = oListRow.Range.Cells
Set oCar = New clsCar
oCar.ID = oCells(, 1).Value
oCar.MAKE = oCells(, 2).Value
oCar.MODEL = oCells(, 3).Value
oCar.DOORS = oCells(, 4).Value
oCar.ENGINE = oCells(, 5).Value
oCars.add oCar
Next
Set oListObject = Worksheets("Sheet1").ListObjects("tblCarProd")
Dim lID As Long
For Each oListRow In oListObject.ListRows
Set oCells = oListRow.Range.Cells
lID = oCells(, 1).Value
Set oCar = oCars.getByID(lID)
If Not oCar Is Nothing Then
oCar.COUNTRY = oCells(, 2).Value
oCar.CarTYPE = oCells(, 3).Value
End If
Next
MsgBox oCars.getByIndex(2).toString
For Each oCar In oCars.getByEngine("V8")
MsgBox oCar.toString
Next
End Sub
I would use a class for each, and an array of each also, so arrCars holds clsCars, and arrProd holds clsProduction. I would then use the index of each for each array when populating, so arrCars(1)=Corvette and arrProd(1)=US Sport then from each you can refer to the others, so if x=3, cars(x) and prod(x) will be correct. Or use a vlookup in excel first, and make one larger table, with the need for only 1 ID then, if that is the way they are related, but can a Bentley also be 3. Its not quite clear what you mean by the 2nd table, is there an entry for each car, or is it like catgeorising the car further, just using a certain selection. Another idea would be to have an extra property in the car class, of ProductionID and then use a static production "table" of classes to refer to.
I have two lists. Both are made of structures I have defined, and this loop is meant to convert the two. I.e., convert and then add to the second list of the other type. Here is what I have:
Dim tempList As New List(Of CameraTemplateProduct)
tempList.Clear()
For j As Integer = 0 To EditCamerasNEW.templateList.Count - 1
'Set up product object.
Dim temp As New CameraTemplateProduct()
'equal properties
temp.Name = EditCamerasNEW.templateList.Item(j).mac
temp.Bitrate = EditCamerasNEW.templateList.Item(j).bitrate
temp.CamDate = EditCamerasNEW.templateList.Item(j).camdate
temp.CamTime = EditCamerasNEW.templateList.Item(j).camtime
temp.Encoder = EditCamerasNEW.templateList.Item(j).encoder
temp.FPS = EditCamerasNEW.templateList.Item(j).fps
temp.Hostname = EditCamerasNEW.templateList.Item(j).hostname
temp.MD = CBool(EditCamerasNEW.templateList.Item(j).MDen)
temp.OSD = CBool(EditCamerasNEW.templateList.Item(j).OSD)
temp.Resolution = EditCamerasNEW.templateList.Item(j).res
tempList.Add(temp)
Next
'Serialize object to a text file.
Dim x As New XmlSerializer((tempList.GetType))
x.Serialize(objStreamWriter, tempList)
Very straight forward. Copy over each property, then add it to the list. When I'm in the loop, temp's values copy over well. The values are exactly the same as the item in TemplateList. When I step through the loop, tempList is exactly what I expect it to be. Three distinct structures. But after wards I get the exact same number of items, but copies of one of them in my list.
However, the line right after the next loop, the tempList instead is the exact same count as templateList, but each value is exactly the same. So every item has the same name, MD, encoder, etc value.
What I've tried: I've tried changing the line after the next to
Dim x As New XmlSerializer((GetType(List(Of CameraTemplateProduct))))
but it gives the same result.
What am I doing wrong? Is there anything the "templist.gettype" is doing to cause this?
EDIT:
I have found that the temp is not changing property values when it loops, so it stays stuck at the first loop values. Is there a better way to clear or set it? I tried setting it to Nothing, but it gave me NULL assignment error.
EDIT2: So following the comments,
I checked to see if the templatelist items were changing. I added a
Dim test = EditCamerasNEW.templateList(j).mac
for each loop to see that it changed. The value did change. I set the rest of the "templatelist.item(j).x" to just "templatelist(j)" as above, but it didn't stop it from creating a list of repeated values.
EDIT3 Tried the below method to no avail. I'm thinking it is possibly when I create the templist of my class. It may not know how to create a list of the product? I will take any help on that.
tempList.Add(New CameraTemplateProduct With {.Name = EditCamerasNEW.templateList(j).mac, _
.Bitrate = EditCamerasNEW.templateList(j).bitrate, _
.CamDate = EditCamerasNEW.templateList(j).camdate, _
.CamTime = EditCamerasNEW.templateList(j).camtime, _
.Encoder = EditCamerasNEW.templateList(j).encoder, _
.FPS = EditCamerasNEW.templateList(j).fps, _
.Hostname = EditCamerasNEW.templateList(j).hostname, _
.MD = EditCamerasNEW.templateList(j).MDen, _
.OSD = EditCamerasNEW.templateList(j).OSD, _
.Resolution = EditCamerasNEW.templateList(j).res})
Here's a portion of the CameraTemplateProduct definition. It's pretty normal:
Public Class CameraTemplateProduct
Public Shared strhostname As String
Public Shared bOSD As Boolean
Public Shared strbitrate As String
Public Shared strencoder As String
Public Shared bMDen As Boolean 'motion detection enabled
Public Shared strres As String
Public Shared intfps As Integer
Public Shared strcamtime As String
Public Shared strcamdate As String
Public Shared strTemplateName As String
'grab properties
Public Property Name() As String
Get
Name = strTemplateName
End Get
Set(ByVal Value As String)
strTemplateName = Value
End Set
End Property
Public Property Hostname() As String
Get
Hostname = strhostname
End Get
Set(ByVal Value As String)
strhostname = Value
End Set
End Property
Public Property OSD() As Boolean
Get
OSD = bOSD
End Get
Set(ByVal Value As Boolean)
bOSD = Value
End Set
End Property
' code continues
Ahoy hoy,
I'm trying to do stuff to a custom object in a custom collection by referencing it's name property in VBA Excel. I swear it worked before (or at least didn't throw an error) and now its kaput. I'm getting an invalid call or argument error when I try to Get something by a string. Thanks in advance for even reading this too, any help is appreciated. <\edit>
Here's the collection:
Option Explicit
Private DRAFields As New Collection
Sub Add(Name As String, Optional colNbr As Long, Optional Exists As Boolean)
Dim fld As New DRAFld
fld.colNbr = colNbr
fld.Name = Name
fld.Exists = Exists
DRAFields.Add fld
End Sub
Property Get Item(NameOrNumber As Variant)
Set Item = DRAFields(NameOrNumber) '<------- Error here
End Property
The collections has items added by passing an array of names in to a function and the collection is returned without issue. I can iterate over by using the key. But the error happens if get as such: Debug.Print myFlds.Item("Customer").colNbr
And the object class just in case:
Option Explicit
Private clmNbrPvt As Long
Private namePvt As String
Private existsPvt As Boolean
Public Property Get colNbr() As Long
colNbr = clmNbrPvt
End Property
Public Property Let colNbr(lngParam As Long)
clmNbrPvt = lngParam
End Property
Public Property Get Name() As String
Name = namePvt
End Property
Public Property Let Name(strParam As String)
namePvt = strParam
End Property
Public Property Get Exists() As Boolean
Exists = existsPvt
End Property
Public Property Let Exists(booParam As Boolean)
existsPvt = booParam
End Property
And why not that function too:
Function validateAndBuildDRAFields(ByRef arrReqFields() As String, _
inputSheet As Worksheet, _
Optional VBAModule As String) As clsDRAFields
Dim lEndCol As Long: lEndCol = Standard.zGetLastColumn(inputSheet, 1)
Dim i As Long
Dim x As Long
Dim intExit As Long
Dim myDRAFields As New clsDRAFields
Set validateAndBuildDRAFields = myDRAFields
'Builds myDRAFields items from arrReqFields
For i = LBound(arrReqFields) To UBound(arrReqFields)
myDRAFields.Add arrReqFields(i)
Next i
'checks if required fields exist on input sheet
'if found then sets column number and exists = true
For i = 1 To myDRAFields.Count
For x = 1 To lEndCol
If inputSheet.Cells(1, x) = myDRAFields.Item(i).Name Then
myDRAFields.Item(i).colNbr = x
myDRAFields.Item(i).Exists = True
intExit = intExit + 1
Exit For
End If
Next x
If intExit = UBound(arrReqFields) + 1 Then Exit For
Next i
' tells user if there are any missing fields and ends if true
If (Not intExit = UBound(arrReqFields) + 1) Or _
intExit = 0 Then
For i = 1 To myDRAFields.Count
If myDRAFields.Item(i).Exists = False Then
Call Standard.TheEndWithError("I couldn't find the " & myDRAFields.Item(i).Name & _
" column in your file. Please add " & myDRAFields.Item(i).Name & _
" to your DRA Layout.", False, VBAModule)
End If
Next i
Set myDRAFields = Nothing
Standard.TheEnd
End If
End Function
To access a collection item by its key, you have to supply a key when you add the item to the collection. The key is optional. When you access a collection item with a string, the Item method assumes you want to match the key. When you use an integer, it assumes you want the positional index.
So, change the line in your Add method to
DRAFields.Add fld, fld.Name
and you'll be able to access items by their Name property.