Access a a nested class from inside another nested class - excel

I have one main class with 3 nested classes looking like this:
Main class:
Option Explicit
Private m_Login As Object
Private m_Archivo As Object
Private m_Equivalencia As Object
Private Property Get Logins(ByVal Key As String) As Logins
With m_Login
If Not .Exists(Key) Then .Add Key, New Logins
End With
Set Logins = m_Login(Key)
End Property
Private Sub Class_Initialize()
Set m_Login = CreateObject("Scripting.Dictionary")
Set m_Archivo = CreateObject("Scripting.Dictionary")
Set m_Equivalencia = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set m_Login = Nothing
Set m_Archivo = Nothing
Set m_Equivalencia = Nothing
End Sub
Private Property Get Keys() As Variant
Keys = m_Login.Keys
End Property
Private Property Get Count() As Long
Count = m_Login.Count
End Property
Private Property Get Items() As Variant
Items = m_Archivo.Keys
End Property
Public Property Get Archivos(ByVal Key As String) As Archivos
With m_Archivo
If Not .Exists(Key) Then .Add Key, New Archivos
End With
Set Archivos = m_Archivo(Key)
End Property
Public Property Get Equivalencias(ByVal Key As String) As Equivalencias
With m_Equivalencia
If Not .Exists(Key) Then .Add Key, New Equivalencias
End With
Set Equivalencias = m_Equivalencia(Key)
End Property
The three nested classes are, as you can see, Logins, Archivos and Equivalencias.
Now I'm trying to get the data stored in Equivalencias class from inside the Logins class.
When doing it from the main class I just need to write Equivalencias(id).Property for example, but I can't seem to call it from inside the nested class Logins.
How would I do it?
I need to do so because inside the Logins class I have this:
Public Property Get ModificacionCentro() As Boolean
If Not Baja And Not Alta Then
Select Case m_Site
Case "GLORIAS" And m_Centro <> "Barcelona Glorias (AESP) (GRAN VÍA DE LAS CORTS CATALANES 866-872, BARCELONA)"
ModificacionCentro = True
Case "ILUSTRACIÓN" And m_Centro <> "Madrid Ilustración (AESP) (C/SANTIAGO DE COMPOSTELA, 94, MADRID)"
ModificacionCentro = True
Case "TÁNGER" And m_Centro <> "MARRUECOS TANGER SUCURSAL (AESP) (RUE IBN FOURMAT ANGLE CARNOT, TANGER 90000 (MAROC))"
ModificacionCentro = True
Case Else
ModificacionCentro = False
End Select
End If
End Property
Right now I'm doing it hardcoded, but If I could access the other class I wouldn't need to, The code would be:
Public Property Get ModificacionCentro() As Boolean
If Not Baja And Not Alta Then
If Not Equivalencias(m_Site) = m_Centro Then ModificacionCentro = False
End If
End Property
And I wouldn't need to hardcode everytime it the sites would change.

Related

Set instance of an object depending of variable inside a class

I have this code inside a class called Tramos
Option Explicit
Private m_Agente As Dictionary
Private m_Pronostico As Dictionary
Property Get Pronosticos(ByVal Key As String) As Pronosticos
With m_Pronostico
If Not .Exists(Key) Then .Add Key, New Pronosticos
End With
Set Pronosticos = m_Pronostico(Key)
End Property
Property Get Agentes(ByVal Key As Integer) As Agentes
With m_Agente
If Not .Exists(Key) Then .Add Key, New Agentes
End With
Set Agentes = m_Agente(Key)
End Property
Private Sub Class_Initialize()
Set m_Agente = New Dictionary
If Not Programaciones Then Set m_Pronostico = New Dictionary
End Sub
Private Sub Class_Terminate()
Set m_Agente = Nothing
If Not Programaciones Then Set m_Pronostico = Nothing
End Sub
Public Property Get Keys() As Variant
Keys = m_Agente.Keys
End Property
Public Property Get PronosKeys() As Variant
PronosKeys = m_Pronostico.Keys
End Property
I have a global variable called Programaciones, if its True then the class wont set the m_Pronostico, I did this because I was experiencing memory problems when working with a lot of instances of this class. The problem comes that when this object is not set, this will most likely throw errors when debugging Object Required I assume because of the PronosKeys property.
Is there any way to set an object inside a class depending of a variable which won't throw errors if I have properties referencing the object I didn't set?

Class module structure, get same property on different levels

I'm trying to build a class module with my whole Company as follows:
Now I know how to achieve this thanks to this answer.
The thing is I am on a planning area which will schedule everyone's work and shifts, so I need to add both Dates and timetable... I want to build a timetable for the whole day dividied by every single minute, so 1440 minutes.
If I were to write the 2 classes with the properties I need such as Auxiliar Time and Workers on the shift, could I call them from any other class without messing with each other?
My goal is to be able to for example sum the Aux time given a day, a group of minutes depending on the department, or the department in a specific location.
I understand this is going to be tedious to write, but is it possible to achieve such a thing?
My code right now calls the Agent which will have different properties, such as his location, service, name and area. By giving his ID you can fill these and if you feed the class a Date, you can get his schedule, department and a comment.
I understand this would have to change, all of it, but I just need to know if is possible what I'm trying to accomplish here, or is there any way more efficient than my initial structure.
My code goes as follows:
Company Class:
Option Explicit
Private ID As Object
Property Get clAgente(ByVal Key As String) As clAgente
With ID
If Not .Exists(Key) Then .Add Key, New clAgente
End With
Set clAgente = ID(Key)
End Property
Public Property Get Count() As Long
Count = ID.Count
End Property
Public Property Get Keys() As Variant
Keys = ID.Keys
End Property
Private Sub Class_Initialize()
Set ID = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set ID = Nothing
End Sub
Agent Class:
Option Explicit
Private Centro As String
Private Servicio As String
Private Nombre As String
Private DirNeg As String
Private Agrup As String
Private Fechas As Object
Property Get Business() As String
Business = DirNeg
End Property
Property Let Business(ByVal param As String)
DirNeg = param
End Property
Property Get Group() As String
Group = Agrup
End Property
Property Let Group(ByVal param As String)
Agrup = param
End Property
Property Get Location() As String
Location = Centro
End Property
Property Let Location(ByVal param As String)
Centro = param
End Property
Property Get Service() As String
Service = Servicio
End Property
Property Let Service(ByVal param As String)
Servicio = param
End Property
Property Get Name() As String
Name = Nombre
End Property
Property Let Name(ByVal param As String)
Nombre = param
End Property
Property Get clHorarios(ByVal Key As Date) As clHorarios
With Fechas
If Not .Exists(Key) Then .Add Key, New clHorarios
End With
Set clHorarios = Fechas(Key)
End Property
Private Sub Class_Initialize()
Set Fechas = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set Fechas = Nothing
End Sub
Public Property Get Count() As Long
Count = Fechas.Count
End Property
Public Property Get Keys() As Variant
Keys = Fechas.Keys
End Property
And finally,
Date class:
Option Explicit
Private m_Horario As String
Private m_Modo As String
Private m_Coment As String
'Aquí creamos la propiedad Horario para la clase Fecha
Public Property Get Horario() As String
Horario = m_Horario
End Property
Public Property Let Horario(ByVal param As String)
m_Horario = param
End Property
'Aquí creamos la propiedad Modo para la clase Fecha
Public Property Get Modo() As String
Modo = m_Modo
End Property
Public Property Let Modo(ByVal param As String)
m_Modo = param
End Property
'Aquí creamos la propiedad Coment para la clase Fecha
Public Property Get Comentario() As String
Comentario = m_Coment
End Property
Public Property Let Comentario(ByVal param As String)
m_Coment = param
End Property
Any insight on the matter would be greatly appreciated.
In a word: Yes
[...] could I call them from any other class without messing with each
other?
Keep in mind that the class is just the structure and meaningless until instantiated and assigned to an object variable that can be copied and modified by any line of code within scope. So, whether or not any class has access to that variable is dependent on scope and whether or not you end up with a mess depends on you and our design.
[...] is it possible to achieve such a thing?
If you did not already know that it is possible to do this thing, then you will have a significant amount of learning to do before you can do this thing.
Any insight on the matter would be greatly appreciated.
Nothing you haven't heard before and you're not already doing: read, try, and learn.

Creating Class properties with sub levels

I've been reading this topic on how to use class modules.
My goal is to improve my code performance and readability so I think I'm in the right path.
But I have some questions about the limitations.
In my head i want to do this:
Is it possible to achieve such a structure?
The topic I've read has very few examples and this is not handled. I'm assuming this would be possible with collections of collections, but I not sure how to look for this.
My data comes from 2 tables, one has all the items but the department and the other one has the ID's alongisde the departments. Both tables have the dates of the current month as headers and their Schedule/Department depending on the table.
I'd know how to achieve this for one day, but not for a whole month.
This is how I wrote the basics for my class:
Option Explicit
Private DirNeg As String
Private Agrup As String
Private DNI As String
Private Centro As String
Private Servicio As String
Private Nombre As String
Property Get Business() As String
Business = DirNeg
End Property
Property Let Business(ByVal sBusiness As String)
DirNeg = sBusiness
End Property
Property Get Group() As String
Group = Agrup
End Property
Property Let Group(ByVal sGroup As String)
Agrup = sGroup
End Property
Property Get ID() As String
ID = DNI
End Property
Property Let ID(ByVal sID As String)
DNI = sID
End Property
Property Get Location() As String
Location = Centro
End Property
Property Let Location(ByVal sLocation As String)
Centro = sLocation
End Property
Property Get Service() As String
Service = Servicio
End Property
Property Let Service(ByVal sService As String)
Servicio = sService
End Property
Property Get Name() As String
Name = Nombre
End Property
Property Let Name(ByVal sName As String)
Nombre = sName
End Property
On the other hand, is it correct to fill the whole class on the Class_Initializeevent? My data will always be the same so I don't need to loop in a normal module to fill the class, it could be done everytime the class is created.
EDIT/UPDATE:
This is how my data looks like:
Schedules alongside Agent's info
Departments alongside Agent's ID
clAgent Class Module:
Option Explicit
Private DirNeg As String
Private Agrup As String
Private DNI As String
Private Centro As String
Private Servicio As String
Private Nombre As String
Private Fechas As Object
Property Get Business() As String
Business = DirNeg
End Property
Property Let Business(ByVal sBusiness As String)
DirNeg = sBusiness
End Property
Property Get Group() As String
Group = Agrup
End Property
Property Let Group(ByVal sGroup As String)
Agrup = sGroup
End Property
Property Get ID() As String
ID = DNI
End Property
Property Let ID(ByVal sID As String)
DNI = sID
End Property
Property Get Location() As String
Location = Centro
End Property
Property Let Location(ByVal sLocation As String)
Centro = sLocation
End Property
Property Get Service() As String
Service = Servicio
End Property
Property Let Service(ByVal sService As String)
Servicio = sService
End Property
Property Get Name() As String
Name = Nombre
End Property
Property Let Name(ByVal sName As String)
Nombre = sName
End Property
Property Get clFechas(ByVal StringKey As String) As clFechas
With Fechas
If Not .Exists(StringKey) Then
Dim objFechas As New clFechas
.Add StringKey, objFechas
End If
End With
End Property
Private Sub Class_Initialize()
Set Fechas = CreateObject("Scripting.Dictionary")
End Sub
clFechas Class Module:
Option Explicit
Private Modos As Object
Private Horarios As Object
'Aqiço creamos la propiedad Modo para la clase Fecha
Public Property Get Modo(ByVal StringKey As String) As String
Modo = Modos(StringKey)
End Property
Public Property Let Modo(ByVal StringKey As String, ByVal StringValue As String)
Modos(StringKey) = StringValue
End Property
Public Property Get Keys() As Variant
Keys = Modos.Keys
End Property
'Aquí creamos la propiedad Horario para la clase Fecha
Public Property Get Horario(ByVal StringKey As String) As String
Modo = Horarios(StringKey)
End Property
Public Property Let Horario(ByVal StringKey As String, ByVal StringValue As String)
Horarios(StringKey) = StringValue
End Property
Public Property Get Keys() As Variant
Keys = Horarios.Keys
End Property
'Iniciamos la clase
Private Sub Class_Initialize()
Set Modos = CreateObject("Scripting.Dictionary")
Set Horarios = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set Modos = Nothing
Set Horarios = Nothing
End Sub
You don’t seem to have any issues with regular properties so let’s focus on the complex ones; Schedule and Department. Both are the same, so same rules apply to both.
The property is basically list, the date is the index and the item is an object. I personally prefer to work with dictionaries as I can look if a key exist etc.
So, your Agent class could look something like this:
Option Explicit
Private m_schedules As Object
Public Property Get Schedule(ByVal Key As Date) As Schedules
With m_schedules
If Not .Exists(Key) Then .Add Key, New Schedules
End With
Set Schedule = m_schedules(Key)
End Property
'For testing purposes - can be ommited.
Public Property Get Keys() As Variant
Keys = m_schedules.Keys
End Property
'For testing purposes - can be ommited.
Public Property Get Count() As Long
Count = m_schedules.Count
End Property
Private Sub Class_Initialize()
Set m_schedules = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set m_schedules = Nothing
End Sub
The Schedules class:
Option Explicit
Private m_schedule As String
Public Property Get Schedule() As String
Schedule = m_schedule
End Property
Public Property Let Schedule(ByVal param As String)
m_schedule = param
End Property
Now, let's test it:
Sub Test()
Dim obj As Agent
Set obj = New Agent
obj.Schedule(#1/9/2019#).Schedule = "Schedule 1"
obj.Schedule(#2/9/2019#).Schedule = "Schedule 2"
obj.Schedule(#3/9/2019#).Schedule = "Schedule 3"
PrintToDebug obj
'Lets make a change
obj.Schedule(#2/9/2019#).Schedule = "Schedule 2222"
PrintToDebug obj
End Sub
Private Sub PrintToDebug(ByVal obj As Agent)
Debug.Print ""
Dim m As Variant
With obj
For Each m In .Keys
Debug.Print "Key: " & m & String(3, " ") & "Value: " & .Schedule(m).Schedule
Next m
End With
Debug.Print "Total Items: " & obj.Count
End Sub
Output:
'Key: 09/01/2019 Value: Schedule 1
'Key: 09/02/2019 Value: Schedule 2
'Key: 09/03/2019 Value: Schedule 3
'Total Items: 3
'Key: 09/01/2019 Value: Schedule 1
'Key: 09/02/2019 Value: Schedule 2222
'Key: 09/03/2019 Value: Schedule 3
'Total Items: 3
Additional information regarding the Dictionary object can be found here: Dictionary object
Also keep this in mind. It's quite important:
If key is not found when changing an item, a new key is created with
the specified newitem. If key is not found when attempting to return
an existing item, a new key is created and its corresponding item is
left empty.
If the dictionary item is not a simple string, let me know to update the answer. Sorry, I couldnt read the data in the screenshots. :)

Acessing a parent's get property gives "Object variable or with block..." error

A have a series of objects, a complex data structure, a parent, and a child. The child contains an instance of the parent, has Let and Get Properties, and one method. When the method requests one of the ComplexData objects from the parent, I'm given the old RunTime Error 91 - Object Variable or With Variable not set message. The child is packaging up all the ComplexData objects from iteself and its parent. The error is generated when the Parent Property Get TitleField() is called by the child.
These are the classes (in bold):
ComplexData
Private sName As String
Private vValue As Variant
Public Property Let Name(sInput As String)
sName = sInput
End Property
Public Property Get Name() As String
Name = sName
End Property
Public Property Let Value(vInput)
vValue = vInput
End Property
Public Property Get Value()
Value = vValue
End Property
ParentClass
Private oTitle As ComplexData
Private Sub Class_Initialize()
Set oTitle = New ComplexData
oTitle.Name = "title"
End Sub
Public Property Let Title(vInput)
oTitle.Value = "Lorum"
End Property
Public Property Get Title()
Value = oTitle.Value
End Property
Public Property Set TitleField(oInput As ComplexData)
Set oTitle = oInput
End Property
Public Property Get TitleField() As ComplexData
TitleField = oTitle 'GENERATES ERROR
End Property
ChildClass
Private oParent As ParentClass
Private oContentData As ComplexData
Private Sub Class_Initialize()
Set oParent = New ParentClass
Set oContentData = New ComplexData
oContentData.Name = "content"
End Sub
Public Property Let Content(sInput As String)
oContentData.Value = sInput
End Property
Public Property Get Content() As String
Content = oContentData.Value
End Property
Public Function getFields()
getFields = Array(oContentData, oParent.TitleField)
End Function
I can get around this by setting oTitle to Public in the parent class, and requesting the object directly instead of using the Property.
I'm calling this from a spreadsheet using the following:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set MyChild = New ChildClass
Fields = MyChild.getFields
field0 = Fields(0).Name
field1 = Fields(1).Name
MsgBox field0 & field1
End Sub
As #Vityata mentioned, adding a “Set” within the Get property fixes the issue.

Trying to set up a custom object model using example, not working

I am trying to set up a custom object model using an example I found in an answered question here on stackoverflow.
VBA Classes - How to have a class hold additional classes
Here is the code I have created based on the answer.
Standard Module
Sub test()
Dim i As Long
Dim j As Long
'code to populate some objects
Dim AssemList As Collection
Dim Assem As cAssem
Dim SubAssemList As Collection
Dim SubAssem As cSubAssem
Set AssemList = New Collection
For i = 1 To 3
Set SubAssemList = New Collection
Set Assem = New cAssem
Assem.Description = "Assem " & i
For j = 1 To 3
Set SubAssem = New cSubAssem
SubAssem.Name = "SubAssem" & j
SubAssemList.Add SubAssem
Next j
Set Assem.SubAssemAdd = SubAssemList '<------ Object variable or With Block not Set
AssemList.Add Assem
Next i
Set SubAssemList = Nothing
'write the data backout again
For Each clock In AssemList
Debug.Print Assem.Description
Set SubAssemList = Assem.SubAssems
For Each SubAssem In SubAssemList
Debug.Print SubAssem.Name
Next
Next
End Sub
cAssem Class
Private pDescription As String
Private pSubAssemList As Collection
Private Sub Class_Initialize()
Set pSubAssems = New Collection
End Sub
Public Property Get Description() As String
Description = pDescription
End Property
Public Property Let Description(ByVal sDescription As String)
pDescription = sDescription
End Property
Public Property Get SubAssems() As Collection
Set SubAssems = pSubAssemList
End Property
Public Property Set SubAssemAdd(AssemCollection As Collection)
For Each AssemName In AssemCollection
pSubAssemList.Add AssemName ' <------- This is the line that is triggering the error
Next
End Property
cSubAssem Class
Private pSubAssemName As String
Public Property Get Name() As String
Name = pSubAssemName
End Property
Public Property Let Name(ByVal sName As String)
pSubAssemName = sName
End Property
I have not changed anything in the code except class names and variable names and from my limited point of view I cannot understand the cause of the error.
I am just starting to really dig into objects and Class Modules in VBA so I appreciate any knowledge this community could pass my way.
Many Thanks
You have a typo in your sub class initializer:
Private Sub Class_Initialize()
Set pSubAssems = New Collection
End Sub
should read:
Private Sub Class_Initialize()
Set pSubAssemList = New Collection
End Sub

Resources