After one scan the variable plc restores the default values.
how i can keep the last values introduced?
i'm using "GetSetting" and "SaveSetting" functions like the example below.
Private Sub TxtBox_IPAdress_TextChanged(sender As Object, e As EventArgs)
SaveSetting(My.Application.Info.AssemblyName, "DadosGerais", "PLC1_IP", TxtBox_IPAdress.Text)
End Sub
code:
Option Explicit On
Imports S7.Net
Module GlobalVar
' Public PLC As Plc
' Public Errorlist As exceptionCode
Public Valor_do_loop_pre_defenido As Integer = 100 'valor médio pretendido para o tempo de ciclo/loop da aplicação
Public hhextracao As String '= "hh"
Public mmextracao As String '= "mm"
Public ssextracao As String '= "ss"
Public thisDay As String '= Date.Now.ToString("dd")
Public thisMonth As String '= Date.Now.ToString("MM")
Public thisYear As String '= Date.Now.ToString("yyyy")
Public thisHour As String '= Date.Now.ToString("HH")
Public thisMinute As String '= Date.Now.ToString("mm")
Public thisSec As String '= Date.Now.ToString("ss")
Public PLC1_IP As String
Public PLC1_Rack As Integer
Public PLC1_Slot As Integer
Public Select_PLC1_Type As Integer
Public PLC1_Type As CpuType
Public PLC1 As New Plc(PLC1_Type, PLC1_IP, PLC1_Rack, PLC1_Slot)
Public test1 As Boolean
Public test1_in As Boolean
Public test1_out As Boolean
Public Sub Settings_Read()
PLC1_IP = GetSetting(My.Application.Info.AssemblyName, "DadosGerais", "PLC1_IP", "192.168.0.10")
PLC1_Rack = GetSetting(My.Application.Info.AssemblyName, "DadosGerais", "PLC1_Rack", "0")
PLC1_Slot = GetSetting(My.Application.Info.AssemblyName, "DadosGerais", "PLC1_Slot", "1")
Select_PLC1_Type = GetSetting(My.Application.Info.AssemblyName, "DadosGerais", "Select_PLC1_Type", "3")
Select Case Select_PLC1_Type
Case 0
PLC1_Type = CpuType.S7200
Case 1
PLC1_Type = CpuType.S7300
Case 2
PLC1_Type = CpuType.S7400
Case 3
PLC1_Type = CpuType.S71200
Case 4
PLC1_Type = CpuType.S71500
Case 5
PLC1_Type = CpuType.S7200Smart
Case 6
PLC1_Type = CpuType.Logo0BA8
Case Else 'default
PLC1_Type = CpuType.S7300
' ComboBox_CPUType.SelectedIndex = ComboBox_CPUType_SelectedIndex
End Select
' Dim PLC As New Plc(PLC1_Type, PLC1_IP, PLC1_Rack, PLC1_Slot)
' PLC1 = PLC
End Sub
End Module
The error I am receiving is: system.typeinitializationexception: the type initializer for 'siemensConnext.globalvar' threw an exception
Inner exception: Argument exception: IP address must be valid. Parameter: ip
shows the next error:
enter image description here
dont see event handler in your code so textchanged nether triggered. change sub declaration as :
Private Sub TxtBox_IPAdress_TextChanged(sender As Object, e As EventArgs) Handles TxtBox_IPAdress.TextChanged
you can use debugger to fix this kind of problem by stopping on sub call.
Related
Not all properties are being assigned correctly. Yet two properties are working. Now, I am aware of the Public ReadOnly auto correction, but I prefer the old get/set method because it helps me to understand more thoroughly. I have in a separate file, another class BusinessLogic:
Public Class BusinessLogic
Private _totalPiecesOfAllUsers As Integer
Private _totalCountOfUsers As Integer
Private _totalEarningsOfAllUsers As Decimal
Private _totalAverageOfAllUsers As Decimal
Private _name As String
Private _pieces As String
Private _individualEarning As Decimal
Public Property TotalPiecesOfAllUsers() As Integer
Get
Return _totalPiecesOfAllUsers
End Get
Set
_totalPiecesOfAllUsers += _pieces
End Set
End Property
Public Property TotalCountOfUsers() As Integer
Get
Return _totalCountOfUsers
End Get
Set
_totalCountOfUsers = value
End Set
End Property
Public Property TotalEarningsOfAllUsers() As Decimal
Get
Return _totalEarningsOfAllUsers
End Get
Set(ByVal value As Decimal)
_totalEarningsOfAllUsers = value
End Set
End Property
Public Property TotalAverageOfAllUsers() As Decimal
Get
Return _totalAverageOfAllUsers
End Get
Set(ByVal value As Decimal)
_totalAverageOfAllUsers = value
End Set
End Property
Public Property Name() As String
Get
Return _name
End Get
Set(ByVal value As String)
_name = value
End Set
End Property
Public Property Pieces() As Integer
Get
Return _pieces
End Get
Set(ByVal value As Integer)
_pieces = value
End Set
End Property
Public Property IndividualEarning() As Decimal
Get
Return _individualEarning
End Get
Set(ByVal value As Decimal)
_individualEarning = value
End Set
End Property
End Class
And then my Form1
Private Sub CalcPayToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles CalcPayToolStripMenuItem.Click
Try
' Create Object
Dim blog As New BusinessLogic
If tbName.Text <> String.Empty And tbPieces.Text <> String.Empty Then
' Get Transactions Per User
blog.Name = tbName.Text
blog.Pieces = Integer.Parse(tbPieces.Text)
blog.IndividualEarning = CalculatePieces(blog.Pieces)
' Counter Per User
blog.TotalCountOfUsers += 1
' Get Total of all users
blog.TotalPiecesOfAllUsers += blog.Pieces
blog.TotalEarningsOfAllUsers += blog.IndividualEarning
blog.TotalAverageOfAllUsers += (blog.TotalEarningsOfAllUsers / blog.TotalCountOfUsers)
Else
' SHow error if field is empty
MsgBox("Name and/or Piece count required")
End If
' Assign asmount earned txtbox the calculated value
lblAmountEarned.Text = FormatCurrency(blog.IndividualEarning)
Catch exc As Exception
' Show error if triggered
MsgBox("Error processing data, values may be empty or incorrect.")
End Try
End Sub
Public Function CalculatePieces(ByVal p As Decimal) As Decimal
' For piece claculation
Dim earningsByPiece As Decimal = 0D
' If pieces fall within range 1-199
If p >= 1 And p <= 199 Then
earningsByPiece = p * 0.5
' If pieces fall within range 200-399
ElseIf p >= 200 And p <= 399 Then
earningsByPiece = p * 0.55
' If pieces fall within range 100-599
ElseIf p >= 400 And p <= 599 Then
earningsByPiece = p * 0.6
' If pieces fall out of 600 range
ElseIf p >= 600 Then
earningsByPiece = p * 0.65
End If
Return earningsByPiece
End Function
Somehow it returns the IndividualEarning, but when I set a break in the BusinessLogic, none of the vraiables are holding anything.
You have started on the wrong foot. Reworking this code, I would start with a class called User. I added a custom constructor so you can add a new user in a single line of code. Then I added back the default constructor.
Public Class User
Public Property Name() As String
Public Property Pieces() As Integer
Public Property IndividualEarning() As Decimal
Public Sub New()
End Sub
Public Sub New(nme As String, pcs As Integer, earnings As Decimal)
Name = nme
Pieces = pcs
IndividualEarning = earnings
End Sub
End Class
Then I created a business logic class to hold the rest of the information. The properties are Shared so they are the same whenever the class is referenced. There is no need to create an instance when you are accessing shared members. Just refer to them with the class name.
Public Class BL
Public Shared Property TotalPiecesOfAllUsers() As Integer
Public Shared Property TotalCountOfUsers() As Integer
Public Shared Property TotalEarningsOfAllUsers() As Decimal
Public Shared Property TotalAverageOfAllUsers() As Decimal
End Class
Then in the Form I created a List(Of User) to hold your User objects.
Now, when you create a User, even though the u will fall out of scope, the user is safely tucked away in the list with the .Add method.
Every time you adjust the contents of the list you call CalculateTotalsAndAverage to keep your BL class up to date.
Dim lst As New List(Of User)
Private Sub CalcPayToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles CalcPayToolStripMenuItem.Click
'Validate input
If tbName.Text = "" Then
MessageBox.Show("Please enter a name")
Exit Sub
End If
Dim pcs As Integer
If Not Integer.TryParse(tbPieces.Text, pcs) Then
MessageBox.Show("Please enter a valid number of pieces")
Exit Sub
End If
Dim u As New User
u.Name = tbName.Text
u.Pieces = pcs
u.IndividualEarning = CalculatePieces(pcs)
lst.Add(u)
CalculateTotalsAndAverage()
lblAmountEarned.Text = FormatCurrency(u.IndividualEarning)
End Sub
Public Function CalculatePieces(ByVal p As Integer) As Decimal
Dim earnings As Decimal = 0D
Select Case p
Case 1 To 199
earnings = p * 0.5D
Case 200 To 399
earnings = p * 0.55D
Case 400 To 599
earnings = p * 0.6D
Case Else
earnings = p * 0.65D
End Select
Return earnings
End Function
Private Sub CalculateTotalsAndAverage()
BL.TotalAverageOfAllUsers = lst.Average(Function(u) u.IndividualEarning)
BL.TotalPiecesOfAllUsers = lst.Sum(Function(u) u.Pieces)
BL.TotalCountOfUsers = lst.Count
BL.TotalEarningsOfAllUsers = lst.Sum(Function(u) u.IndividualEarning)
Debug.Print($"Average {BL.TotalAverageOfAllUsers} Total Pieces {BL.TotalPiecesOfAllUsers} Total Earnings {BL.TotalEarningsOfAllUsers}")
End Sub
I'm getting an exception... LINQ to Entities does not recognize the method 'System.Object CompareObjectEqual(System.Object, System.Object, Boolean)' method, and this method cannot be translated into a store expression.
My Entity has a table with 3 fields A_Id is an autonumber Integer, TidFk is an Integer and AuditNotes is a Nvarchar(Max), not Null, default ''
My Model has the following.
Public Class Audit
Public Property AId As Integer
Public Property TIdFk As Integer
Public Property AuditNote As String
Public Sub New()
AId = 0
TIdFk = 0
AuditNote = ""
End Sub
Public Sub GetAuditFor(tID)
Dim de As New EHREntities
Try
Dim aud = (From a In de.Tbl_Audit
Where a.TidFk = tID
Select a).FirstOrDefault()
If IsNothing(aud) Then
AId = 0
TIdFk = tID
AuditNote = ""
Else
AId = aud.A_id
TIdFk = aud.TidFk
AuditNote = aud.AuditNote.ToString().Replace("<<", "<b>").Replace(">>", "</b>").Replace("<>", " <span class="" error"">•</span> ")
End If
Catch ex As Exception
AId = 0
TIdFk = tID
AuditNote = "<span class=""error"">Error! </span>" & ex.Message
Finally
de.Dispose()
End Try
End Sub
End Class
My Controller has...
Function FetchAuditFor(tId As Integer) As PartialViewResult
Dim auditNote As New Audit
auditNote.GetAuditFor(tId)
Return PartialView("_AuditNote", auditNote)
End Function
The Class fails with the above mentioned exception from Sub GetAuditFor(tID)...
I've tried all I know to determine the reason for the exception but have failed... The exception mentions Boolean but there are no booleans... Any help appreciated.
AMATEUR!... Public Sub GetAuditFor(tID) should have been Public Sub GetAuditFor(tID As Integer).... That's an hour of my life I won't get back!
I'm updating a program and there is about 40 classes. I need to create a function that takes two lists of type object as parameters. Both lists only have one item in them (A version of the item BEFORE any changes were made, and AFTER the changes happened). I'm using these objects to create a single object to implement an UNDO button. With these parameters I need to get the type of each and make sure they match, if not then something went wrong. Next I'll need to read in the fields/properties/members (Not sure what to choose) and then compare them to each other and find what changed so I can set that as the item description. I don't want to trace the whole code and add specific functions for each and I know there has got to be a way to do this generically. I have created this small mock-up program that semi works for what I am trying to do. I can get the class type out of the object in list, but i have no idea how to get fields or whatever.
I'm using a large database with entity framework.
Also Using VB.NET!
Thanks for the help!
Here's code for generic program:
Imports System.Reflection
Module Module1
Sub Main()
Dim Myself As New Human("Matthew", "Cucco", Now, "Blonde", 19, False)
Dim NotMe As New Human("Jake", "Cucco", Now, "Blonde", 19, False)
Dim Him As New Employee("Matt", "Cucco", Now, "Blonde", 19, False, 215, "LuK", True)
Dim Her As New Customer("Jessie", "Keller", Now, "Blonde", 19, True, 25, "Cereal", "me#gmail.com")
Dim ListofPeople As IList(Of Object) = {Myself, NotMe, Him, Her}
Dim ListofPeople2 As IList(Of Object) = {Myself, NotMe, Him, Her}
ObjectsAreSameClass(ListofPeople, ListofPeople2)
Console.ReadKey()
End Sub
Private Function ObjectsAreSameClass(object1 As IList(Of Object), object2 As IList(Of Object)) As Boolean
Dim ObjectType As Type = object1.First.GetType()
Dim AreSameClass As Boolean = Nothing
Console.WriteLine(ObjectType.ToString)
If (object1.First.GetType() = object2.First.GetType()) Then
AreSameClass = True
Console.WriteLine("Object1 is of type: " + object1.First.GetType().Name)
Console.WriteLine("Object2 is of type: " + object2.First.GetType().Name)
If (object1.First.GetType().Name = "Human") Then
Console.WriteLine("Yep this works")
End If
Else
AreSameClass = False
Console.WriteLine("Object1 is of type: " + object1.First.GetType().Name)
Console.WriteLine("Object2 is of type: " + object2.First.GetType().Name)
If (object1.First.GetType().Name = "Human") Then
Console.WriteLine("Yep this works")
Console.WriteLine(object1.First.GetType().GetFields().ToString)
End If
End If
Dim MyField As PropertyInfo() = ObjectType.GetProperties()
Dim i As Integer
For i = 0 To MyField.Length - 1
Console.WriteLine(MyField(i).ToString)
Next i
Console.WriteLine("Objects are equal? t/f : " + AreSameClass.ToString)
Return AreSameClass
End Function
Public Class Human
Public FirstName As String
Public LastName As String
Public Birthdate As Date
Public HairColor As String
Public Age As Integer
Public Gender As Boolean 'False for male, true for female
Public Sub New()
FirstName = ""
LastName = ""
Birthdate = Now
HairColor = ""
Age = 0
Gender = False
End Sub
Public Sub New(f As String, l As String, b As Date, h As String, a As Integer, g As Boolean)
FirstName = f
LastName = l
Birthdate = b
HairColor = h
Age = a
Gender = g
End Sub
End Class
Public Class Employee
Inherits Human
Dim EmployeeId As Integer
Dim PlaceOfEmployment As String
Dim IsManager As Boolean
Public Sub New()
MyBase.New()
EmployeeId = 0
PlaceOfEmployment = ""
IsManager = False
End Sub
Public Sub New(f As String, l As String, b As Date, h As String, a As Integer, g As Boolean, i As Integer, p As String, m As Boolean)
MyBase.New(f, l, b, h, a, g)
EmployeeId = i
PlaceOfEmployment = p
IsManager = m
End Sub
End Class
Public Class Customer
Inherits Human
'used for testing
Dim IdNumber As Integer
Dim FavoriteItem As String
Dim email As String
Public Sub New()
MyBase.New()
IdNumber = 0
FavoriteItem = ""
email = ""
End Sub
Public Sub New(f As String, l As String, b As Date, h As String, a As Integer, g As Boolean, i As Integer, fav As String, e As String)
MyBase.New(f, l, b, h, a, g)
IdNumber = i
FavoriteItem = fav
email = e
End Sub
End Class
End Module
This Currently displays this:
TestProject.Module1+Human
Object1 is of type: Human
Object2 is of type: Human
Yep this works
Objects are equal? t/f : True
Also for reference, here is my main program that I will be implementing this into:
Function NewItem(Before As IEnumerable(Of Object), After As IEnumerable(Of Object), ObjectType As String)
ObjectsAreSameClass(Before, After, ObjectType) 'Check if objects are same class
Dim BeforeFields() As FieldInfo = GetFieldData(Before) 'gets all field info, saves to an array
Dim AfterFields() As FieldInfo = GetFieldData(After)
'Now check and make sure the objects are not the same
Dim ThisChanged As FieldInfo
If (ObjectValuesAreEqual(BeforeFields, AfterFields) = True) Then
'These objects did not not change
ThisChanged = Nothing
Else
'Change occured, find out where
ThisChanged = FindWhatChanged(BeforeFields, AfterFields)
End If
'Create a new UndoRedo item and give it these values
Dim UndoRedoNow As New ClsUndoRedo
UndoRedoNow.BeforeObject = Before.Single
UndoRedoNow.AfterObject = After.Single
UndoRedoNow.ObjectCounter += 1
UndoRedoNow.WhatChanged = ThisChanged
If WhatGroupChanged.isDeleted Then
UndoRedoNow.WhatAction = Before.Single.GetType().ToString + " item was Deleted"
ElseIf WhatGroupChanged.isNew Then
UndoRedoNow.WhatAction = After.Single.GetType().ToString + " item was created"
ElseIf WhatGroupChanged.isChanged Then
UndoRedoNow.WhatAction = After.Single.GetType().ToString + " item was changed"
End If
UndoRedoNow.WhatGroupChanged.isRedo = False 'Make sure it is not a redo object
'Now add object to list
ChangeLog.Add(UndoRedoNow)
Return Nothing
End Function
Private Function ObjectsAreSameClass(before As IEnumerable(Of Object), after As IEnumerable(Of Object), WhatType As String) As Boolean
Dim AreSameClass As Boolean = False
Try
If (before.Single.GetType() = after.Single.GetType() Or (before Is Nothing) Or (after Is Nothing)) Then
'Objects are of the same class or nothing
If before Is Nothing Then
WhatGroupChanged.isNew = True 'New item
ElseIf after Is Nothing Then
WhatGroupChanged.isDeleted = True 'Deleted item
Else
WhatGroupChanged.isChanged = True 'item was changed
End If
AreSameClass = True
End If
Catch
'Need to raise error
End Try
Return AreSameClass
End Function
''' <summary>
''' This function will return all of the fields for a certain class as well as the data stored in them
''' </summary>
''' <param name="list"></param>
''' <returns></returns>
Public Shared Function GetFieldData(ByVal list As IList(Of Object)) As FieldInfo()
Dim fields() As FieldInfo = list.Single.GetType().GetFields()
Return fields
End Function
''' <summary>
''' This function will check that the values in the datafields are not equal
''' </summary>
''' <param name="Before"></param>
''' <param name="After"></param>
''' <returns></returns>
Private Function ObjectValuesAreEqual(Before() As FieldInfo, After() As FieldInfo) As Boolean
Dim isEqual As Boolean = New Boolean 'This will keep track of if the elements are equal or not
For index As Integer = 0 To (Before.Count - 1)
If Before.ElementAt(index).GetValue(Before.ElementAt(index)).Equals(After.ElementAt(index).GetValue(After.ElementAt(index))) Then
'They are equal so set to true
isEqual = True
Else
'They are not equal so set to false and return
isEqual = False
Return isEqual
End If
Next
Return isEqual
End Function
Private Function FindWhatChanged(Before() As FieldInfo, After() As FieldInfo) As FieldInfo
Dim ThisIsChange As FieldInfo
For index As Integer = 0 To (Before.Count - 1)
If Before.ElementAt(index).GetValue(Before.ElementAt(index)).Equals(After.ElementAt(index).GetValue(After.ElementAt(index))) Then
ThisIsChange = After.ElementAt(index)
Return ThisIsChange
Else
'Raise error
End If
Next
End Function
The proper way to preserve type information when working with unknown types is to write a generic function (and if necessary generic classes, structures, etc.).
Using GetType, in a perfect world, should never be needed.
Generic functions look like this:
Public Function MyGenericFunction(Of T)(myArg as T) as Integer
' do something with myArg1, myArg2 ... without knowing their exact type
Return 0
End Function
' or with multiple types
Public Function MyGenericFunction2(Of T1, T2, ... )(myArg1 as T1, myArg2 as T2, ...) as T1()
' do something with myArg1, myArg2 ... without knowing their exact type
Return { myArg1 }
End Function
When you call these functions, the generic types are usually automatically deduced from the arguments you passed. If they can't be guessed, you will need to explicitly annotate the types, like this:
Dim x = MyGenericFunction(Of SomeClass1)(foo)
Dim x = MyGenericFunction(Of SomeClass2)(foo)
A full guide here: https://msdn.microsoft.com/en-us/library/w256ka79.aspx
However, if you need to handle specific types with the same function, then what you want to do use is a more narrow tool: overloading, or more technically parametric polymorphism.
What that means is, you will need to provide two (or more) different definitions of the same function ( = having the same name), that accept parameters of different types.
A simple example:
Public Class MyClass1
Public Foo1 As String = "foo1"
End Class
Public Class MyClass2
Public Foo2 As String = "foo2"
End Class
Public Sub MyFunction(arg as MyClass1)
Console.WriteLine(arg.Foo1)
End Sub
Public Sub MyFunction(arg as MyClass2)
Console.WriteLine(arg.Foo2)
End Sub
Dim x as Object
' let's give x a random value of either MyClass1 or MyClass2,
' and we don't know in advance which one
If DateTime.Today.DayOfWeek = DayOfWeek.Tuesday Then
x = new MyClass1
Else
x = new MyClass2
End If
' the program will automatically invoke the correct function based on x's value, and print either "foo1" or "foo2"
MyFunction(x)
VB.NET 2010~Framework 3.5
Is there a way to dynamically specify property names of a class?
Sometimes I need a list created from Prop1 and Prop2
Other times I need a list created from Prop2 and Prop4 etc.. The target properties are not known ahead of time, they constantly change as the app is running. . .
Option Strict On
Option Explicit On
Public Class Form1
Private Class Things
Public Property Prop1 As String
Public Property Prop2 As String
Public Property Prop3 As String
Public Property Prop4 As String
End Class
Private Class SubThing
Public Property P1 As String
Public Property P2 As String
End Class
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim mainLst As New List(Of Things)
Dim count As Integer
Do Until count = 20
mainLst.Add(New Things With {.Prop1 = count.ToString, _
.Prop2 = (count + 1).ToString, _
.Prop3 = (count + 2).ToString, _
.Prop4 = (count + 3).ToString})
count += 1
Loop
' Need to dynamically pick properties From mainLst into subLst.
' The commented code below wont compile but demonstrates what I'm trying to do
' can this be done without looping?
'Dim propNameA As String = "Prop1" ' Dynamically specify a property name
'Dim propNameB As String = "Prop4"
'Dim subLst = From mainItem In mainLst
' Select New SubThing() With {.P1 = mainItem.propNameA, .P2 = mainItem.propNameB}
' This code below compiles but lacks the dynamics I need?
Dim subLst = From mainItem In mainLst
Select New SubThing() With {.P1 = mainItem.Prop1, .P2 = mainItem.Prop4}
End Sub
The most direct approach would be to use CallByName (MSDN Link). I'm assuming your example is a simplified version of what you're really working with, but it seems like an even better approach would be to get rid of your Prop1, Prop2, ... string properties and just use a List(Of String) which you can then just index into, without having to frankenstein together the property names with an index value. Example:
Public Property Props As List(Of String)
'...
Dim subLst = From mainItem In mainLst
Select New SubThing() With {.P1 = mainItem.Props(1), .P2 = mainItem.Props(4)}
Not really sure what your exact use case is from your example, but hopefully this points you in the right direction.
Here's an example using reflection as helrich# suggested. (you have to Imports System.Reflection at the top of your .vb file)
1) Naive console outputting example:
Dim thingType As Type = GetType(Things)
Dim prop1Property As PropertyInfo = thingType.GetProperty("Prop1")
Dim thingInstance As Things = New Things()
thingInstance.Prop1 = "My Dynamically Accessed Value"
Dim prop1Value = prop1Property.GetValue(thingInstance).ToString()
Console.WriteLine(prop1Value)
2) Adapted to your example ("probably" works, haven't tested it all):
Dim propNameA As String = "Prop1" ' Dynamically specify a property name
Dim propNameB As String = "Prop4"
Dim propAPropInfo As PropertyInfo = GetType(Things).GetProperty(propNameA)
Dim propBPropInfo As PropertyInfo = GetType(Things).GetProperty(propNameB)
Dim subLst = From mainItem In mainLst
Select New SubThing() With {.P1 = propAPropInfo.GetValue(mainItem).ToString(), .P2 = propBPropInfo.GetValue(mainItem).ToString()}
Option Strict On
Option Explicit On
Imports System.Reflection
Module Module1
Private Class SourceClass
Public Property Prop1 As String
Public Property Prop2 As String
Public Property Prop3 As String
Public Property Prop4 As String
End Class
Private Class SubClass
Public Property P1 As String
Public Property P2 As String
End Class
Sub Main()
Dim mainLst As New List(Of SourceClass)
Dim count As Integer
Do Until count = 20 ' create source list
mainLst.Add(New SourceClass With {.Prop1 = count.ToString, _
.Prop2 = (count + 1).ToString, _
.Prop3 = (count + 2).ToString, _
.Prop4 = (count + 3).ToString})
count += 1
Loop
Dim propAInfo As PropertyInfo = GetType(SourceClass).GetProperty("Prop1") ' Dynamically specify a property name
Dim propBInfo As PropertyInfo = GetType(SourceClass).GetProperty("Prop3")
' create a list of SubClass from SourceClass
Dim subLst = From mainItem In mainLst Select New SubClass() _
With {.P1 = propAInfo.GetValue(mainItem, Nothing).ToString, _
.P2 = propBInfo.GetValue(mainItem, Nothing).ToString}
count = 0
Do Until count = subLst.Count
Debug.WriteLine(subLst(count).P1 & "~" & subLst(count).P2)
count += 1
Loop
End Sub
End Module
I keep getting the annoying error message: Application-defined or object-defined error (VBA).
Background: I have a worksheet that contains rows and columns (some rows & columns are merged), I have a button on the worksheet that I would like to use to validate the worksheet e.g. to report any errors if a cell is not filled in i.e. empty. In additions, I would like empty cells to become red when the button is clicked on an a particular range of cells contain no values.
I created a VBA Bean to hold all rows of data that are pulled from the worksheet. This class will contain procedures and/or functions that validate the class and hopefully report back to the user any errors encountered. The button calls the print_cheque_Click() (worksheet code below). Any suggestions here would be much appreciated. Thanks in advance.
line where error is occurring: Range(cCel).Interior.Color = RGB(255, 0, 0)
error
Public Sub validate()
Dim str As String
Dim cCel As String
Dim WS As Worksheet
Set WS = Worksheets("EFF_PAYROLL")
WS.Select
With Selection
If Me.getJournalYear = "" Then
cCel = Me.getJournalYearCell
**Range(cCel).Interior.Color = RGB(255, 0, 0)**
Else
**Range(cCel).Interior.Color = RGB(255, 255, 255)**
End If
End With
End Sub
class employee
Option Explicit
'****************************
'class definition of Employee
'VBA Bean
'****************************
'******************
'private Attributes
'******************
Private eID As Integer
Private jYear As String
Private jYearCell As String
Private eRegion As String
Private eRegionCell As String
Private eDistrict As String
Private eDistrictCell As String
Private eJournalNumber As String
Private eJournalNumberCell As String
Private eName As String
Private eNameCell As String
Private class_code As String
Private class_codeCell As String
Private hourly_rate As String
Private hourly_rateCell As String
Private eCertNumber As String
Private eCertNumberCell As String
Private eRegRate As String
Private eRegRateCell As String
Private eRegHours As String
Private eRegHoursCell As String
Private eOvertimeRate As String
Private eOvertimeRateCell As String
Private eOvertimeHours As String
Private eOvertimeHoursCell As String
Private eRegTotal As String
Private eRegTotalCell As String
Private eOvertimeTotal As String
Private eOvertimeTotalCell As String
Private eVacationTotal As String
Private eVacactionTotalCell As String
Private eTotalPay As String
Private eTotalPayCell As String
Private eCommissary As String
Private eCommissaryCell As String
Private eTotalCommissary As String
Private eTotalCommissaryCell As String
Private eNetPay As String
Private eNetPayCell As String
Private eDay As String
Private eDayCell As String
Private eMonth As String
Private eMonthCell As String
Private eYear As String
Private eYearCell As String
Private eChequeNo As String
Private eChequeNoCell As String
Private eAddress1 As String
Private eAddress1Cell As String
Private eAddress2 As String
Private eAddress2Cell As String
Private eAuthorizedOfficer As String
Private eAuthorizedOfficerCell As String
Private ePrintedName As String
Private ePrintedNameCell As String
Private ePreparedBy As String
Private ePreparedByCell As String
'***************
'Get/Set Methods
'***************
'*******************************************
'eID section
Public Property Get getID() As String
getID = eID
End Property
Public Property Let setID(value As String)
setID = value
End Property
'END eID section
'*******************************************
'journal year
Public Property Get getJournalYear() As String
getJournalYear = jYear
End Property
Public Property Let setJournalYear(value As String)
jYear = value
End Property
'end journal year
'setJournalYearCell
Public Property Get getJournalYearCell() As String
getJournalYearCell = jYearCell
End Property
Public Property Let setJournalYearCell(value As String)
jYearCell = value
End Property
'end setJournalYearCell
'class code
Public Property Get getClassCode() As String
getClassCode = class_code
End Property
Public Property Let setClassCode(value As String)
class_code = value
End Property
'end class code
'class code cell
Public Property Get getClassCodeCell() As String
getClassCodeCell = class_codeCell
End Property
Public Property Let setClassCodeCell(value As String)
class_codeCell = value
End Property
'end class code code cell
'hourly rate
Public Property Get getHourlyRate() As String
getHourlyRate = hourly_rate
End Property
Public Property Let setHourlyRate(value As String)
hourly_rate = value
End Property
'end hourly rate
'hourly rate cell
Public Property Get getHourlyRatCell() As String
getHourlyRateCell = hourly_rateCell
End Property
Public Property Let setHourlyRateCell(value As String)
hourly_rateCell = value
End Property
'end hourly rate cell
'chequeNo
Public Property Get getChequeNo() As String
getChequeNo = eChequeNo
End Property
Public Property Let setchequeNo(value As String)
eChequeNo = value
End Property
'end chequeNo
'chequeNoCell
Public Property Get getChequeNoCell() As String
getChequeNoCell = eChequeNoCell
End Property
Public Property Let setChequeNoCell(value As String)
eChequeNoCell = value
End Property
'end chequeCell
'prepredBy
Public Property Get getPreparedBy() As String
getPreparedBy = ePreparedBy
End Property
Public Property Let setPreparedBy(value As String)
ePreparedBy = value
End Property
'end preparedBy
'preparedByCell
Public Property Get getPreparedByCell() As String
getPreparedByCell = ePreparedByCell
End Property
Public Property Let setPreparedByCell(value As String)
ePreparedByCell = value
End Property
'end preparedByCell
'region
Public Property Get getRegion() As String
getRegion = eRegion
End Property
Public Property Let setRegion(value As String)
eRegion = value
End Property
'end region
'regionCell
Public Property Get getRegionCell() As String
getRegionCell = eRegionCell
End Property
Public Property Let setRegionCell(value As String)
eRegionCell = value
End Property
'end regionCell
'BEGIN
'district
Public Property Get getDistrict() As String
getDistrict = eDistrict
End Property
Public Property Let setDistrict(value As String)
eDistrict = value
End Property
'end district
'districtCell
Public Property Get getDistrictCell() As String
getDistrictCell = eDistrictCell
End Property
Public Property Let setDistrictCell(value As String)
eDistrictCell = value
End Property
'end districtCell
'eYear section
Public Property Get getYear() As String
getYear = eYear
End Property
Public Property Let setYear(value As String)
eYear = value
End Property
'END eYear Section
'eYearCell
Public Property Get getEYearCell() As String
getEYearCell = eYearCell
End Property
Public Property Let setEYearCell(value As String)
eYearCell = value
End Property
'end eYearCell
'eMonth section
Public Property Get getMonth() As String
getMonth = eMonth
End Property
Public Property Let setMonth(value As String)
eMonth = value
End Property
'END eMonth Section
'eMonthCell
Public Property Get getEMonthCell() As String
getEMonthCell = eMonthCell
End Property
Public Property Let setEMonthCell(value As String)
eMonthCell = value
End Property
'end eMonthCell
'eDay section
Public Property Get getDay() As String
getDay = eDay
End Property
Public Property Let setDay(value As String)
eDay = value
End Property
'END eDay Section
'eDayCell
Public Property Get getEDayCell() As String
getEDayCell = eDayCell
End Property
Public Property Let setEDayCell(value As String)
eDayCell = value
End Property
'end eDayCell
'eJournalNumber section
Public Property Get getJournalNumber() As String
getJournalNumber = eJournalNumber
End Property
Public Property Let setJournalNumber(value As String)
eJournalNumber = value
End Property
'end journal number
'eJournalNumberCell
Public Property Get getJournalNumberCell() As String
getJournalNumberCell = eJournalNumberCell
End Property
Public Property Let setJournalNumberCell(value As String)
eJournalNumberCell = value
End Property
'end eJournalNumberCell
'eName Section
Public Property Get getName() As String
getName = eName
End Property
Public Property Let setName(value As String)
eName = value
End Property
'END eName section
'eNameCell
Public Property Get getNameCell() As String
getNameCell = eNameCell
End Property
Public Property Let setNameCell(value As String)
eNameCell = value
End Property
'end eNameCell
'address1
Public Property Get getAddress1() As String
getAddress1 = eAddress1
End Property
Public Property Let setAddress1(value As String)
eAddress1 = value
End Property
'end address1
'adress1Cell
Public Property Get getAddress1Cell() As String
getAddress1Cell = eAddress1Cell
End Property
Public Property Let setAAddress1Cell(value As String)
eAddress1Cell = value
End Property
'end address1Cell
'address2
Public Property Get getAddress2() As String
getAddress2 = eAddress2
End Property
Public Property Let setAddress2(value As String)
eAddress2 = value
End Property
'end address2
'address2Cell
Public Property Get getAddress2Cell() As String
getAddress2Cell = eAddress2
End Property
Public Property Let setAddress2cell(value As String)
eAddress2Cell = value
End Property
'end address2Cell
'certNumber
Public Property Get getCertNumber() As String
getCertNumber = eCertNumber
End Property
Public Property Let setCertNumber(value As String)
eCertNumber = value
End Property
'end certNumber
'certNumberCell
Public Property Get getCertNumberCell() As String
getCertNumberCell = eCertNumberCell
End Property
Public Property Let setCertNumberCell(value As String)
eCertNumberCell = value
End Property
'end CertNumberCell
'regRate
Public Property Get getRegRate() As String
getRegRate = eRegRate
End Property
Public Property Let setRegRate(value As String)
eRegRate = value
End Property
'end regRate
'regRateCell
Public Property Get getRegRateCell() As String
getRegRateCell = eRegRateCell
End Property
Public Property Let setRegRateCell(value As String)
eRegRateCell = value
End Property
'end regRateCell
'regHours
Public Property Get getRegHours() As String
getRegHours = eRegHours
End Property
Public Property Let setRegHours(value As String)
eRegHours = value
End Property
'end regHours
'regHoursCell
Public Property Get getRegHoursCell() As String
getRegHours = eRegHoursCell
End Property
Public Property Let setRegHoursCell(value As String)
eRegHoursCell = value
End Property
'end regHoursCell
'overtimeRate
Public Property Get getOvertimeRate() As String
getOvertimeRate = eOvertimeRate
End Property
Public Property Let setOvertimeRate(value As String)
eOvertimeRate = value
End Property
'end overtimeRate
'overtimeRateCell
Public Property Get getOvertimeRateCell() As String
getOvertimeRateCell = eOvertimeRateCell
End Property
'end
Public Property Let setOvertimeRateCell(value As String)
eOvertimeRateCell = value
End Property
'end overtimeRateCell
'overtimeHours
Public Property Get getOvertimeHours() As String
getOvertimeHours = eOvertimeHours
End Property
Public Property Let setOvertimeHours(value As String)
eOvertimeHours = value
End Property
'end overtimeHours
'overtimeHoursCell
Public Property Get getOvertimeHoursCell() As String
getOvertimeHoursCell = eOvertimeHoursCell
End Property
Public Property Let setOvertimeHoursCell(value As String)
eOvertimeHoursCell = value
End Property
'end overtimeHoursCell
'regTotal
Public Property Get getRegTotal() As String
getRegTotal = eRegTotal
End Property
Public Property Let setRegTotal(value As String)
eRegTotal = value
End Property
'end regTotal
'regTotalCell
Public Property Get getRegTotalCell() As String
getRegTotalCell = eRegTotalCell
End Property
Public Property Let setRegTotalCell(value As String)
eRegTotalCell = value
End Property
'end regTotalCell
'overtimeTotal
Public Property Get getOvertimeTotal() As String
getOvertimeTotal = eOvertimeTotal
End Property
Public Property Let setOvertimeTotal(value As String)
eOvertimeTotal = value
End Property
'end overtimeTotal
'overtimeTotalCell
Public Property Get getOvertimeTotalCell() As String
getOvertimeTotalCell = eOvertimeTotalCell
End Property
Public Property Let setOvertimeTotalCell(value As String)
eOvertimeTotalCell = value
End Property
'end overtimeTotalCell
'vacationTotal
Public Property Get getVacationTotal() As String
getVacationTotal = eVacationTotal
End Property
Public Property Let setVacationTotal(value As String)
eVacationTotal = value
End Property
'end vacationTotal
'vacationTotalCell
Public Property Get getVacationTotalCell() As String
getVacationTotalCell = eVacationTotalCell
End Property
Public Property Let setVacationTotalCell(value As String)
eVacationTotalCell = value
End Property
'end vacationTotalCell
'totalPay
Public Property Get getTotalPay() As String
getTotalPay = eTotalPay
End Property
Public Property Let setTotalPay(value As String)
eTotalPay = value
End Property
'end totalPay
'totalPayCell
Public Property Get getTotalPayCell() As String
getTotalPayCell = eTotalPayCell
End Property
Public Property Let setTotalPayCell(value As String)
eTotalPayCell = value
End Property
'end totalPayCell
'revisit
'************ buffer issue ? ********************
'commissary
Public Property Get getCommissary() As String
getCommissary = eCommissary
End Property
Public Property Let setCommissary(value As String)
eCommissary = value
End Property
'end commissary
'commissary
Public Property Get getCommissaryCell() As String
getCommissaryCell = eCommissaryCell
End Property
Public Property Let setCommissaryCell(value As String)
eCommissaryCell = value
End Property
'end commissary
'totalCommissary
Public Property Get getTotalCommissary() As String
getTotalCommissary = eTotalCommissary
End Property
Public Property Let setTotalCommissary(value As String)
eTotalCommissary = value
End Property
'end totalCommissary
'totalCommissaryCell
Public Property Get getTotalCommissaryCell() As String
getTotalCommissaryCell = eTotalCommissary
End Property
Public Property Let setTotalCommissaryCell(value As String)
eTotalCommissaryCell = value
End Property
'end totalCommissaryCell
'netPay
Public Property Get getNetPay() As String
getNetPay = eNetPay
End Property
Public Property Let setNetPay(value As String)
eNetPay = value
End Property
'end netPay
'netPayCell
Public Property Get getNetPayCell() As String
getNetPayCell = eNetPayCell
End Property
Public Property Let setNetPayCell(value As String)
eNetPayCell = value
End Property
'end netPayCell
'authorizedOfficer
Public Property Get getAuthorizedOfficer() As String
getAuthorizedOfficer = eAuthorizedOfficer
End Property
Public Property Let setAuthorizedOfficer(value As String)
eAuthorizedOfficer = value
End Property
'end authorizedOfficer
'authorizedOfficerCell
Public Property Get getAuthorizedOfficerCell() As String
getAuthorizedOfficerCelll = eAuthorizedOfficerCell
End Property
Public Property Let setAuthorizedOfficerCell(value As String)
eAuthorizedOfficerCell = value
End Property
'end authorizedOfficer
'printedName
Public Property Get getPrintedName() As String
getPrintedName = ePrintedName
End Property
Public Property Let setPrintedName(value As String)
ePrintedName = value
End Property
'end printedName
'printedNameCell
Public Property Get getPrintedNameCell() As String
getPrintedNameCell = ePrintedNameCell
End Property
Public Property Let setPritnedNameCell(value As String)
ePrintedNameCell = value
End Property
'end printedNameCell
'***************
'Procedure / Function
'***************
Public Sub validate()
Dim str As String
Dim cCel As String
Dim WS As Worksheet
Set WS = Worksheets("EFF_PAYROLL")
WS.Select
With Selection
If Me.getJournalYear = "" Then
cCel = Me.getJournalYearCell
Range(cCel).Interior.Color = RGB(255, 0, 0)
Else
Range(cCel).Interior.Color = RGB(255, 255, 255)
End If
End With
End Sub
'constructor
Private Sub Class_Initialize()
'assign an ID to each new employee object
eID = eID + 1
End Sub
'end constructor
worksheet code
Private Sub print_cheque_Click()
Dim template As Worksheet
Dim rng As Range
Dim journal As Range
Dim iReply As Integer
Dim row As Range
Dim cell As Range
Dim employeeCollection As Collection
Set employeeCollection = New Collection
'EFF_PAYROLL fields
Dim dayStr As String
Dim monthStr As String
'boolean flag - if error is raised don't print cheque
Dim errorFlag As Boolean
errorFlag = True 'raise error if no fields are filled in
Dim str As String
'*************************
'work with Employee Object
'*************************
'find the number of cheques to be created by cheque number
Set rng = Sheets("EFF_PAYROLL").Range("a7:a35")
'define employee object
Dim emp As employee
'********local variables **********
'**********************************
Dim year As String
Dim cell_address As String
Dim name As String
For Each row In rng.Rows
'create new employee foreach row
Set emp = New employee
For Each cell In row.Cells
'++++++++++++++++++++++++++++++++++++
'grab all values from payroll_journal
'populate VBA Bean - Employee Type
'++++++++++++++++++++++++++++++++++++
'*** header info *******************************************
emp.setJournalYear = Sheets("EFF_PAYROLL").Range("O3").value
emp.setJournalYearCell = "O3"
emp.setRegion = Sheets("EFF_PAYROLL").Range("P3").value
emp.setRegionCell = "P3"
emp.setDistrict = Sheets("EFF_PAYROLL").Range("Q3").value
emp.setDistrictCell = "Q3"
emp.setJournalNumber = Sheets("EFF_PAYROLL").Range("R3").value
emp.setJournalNumberCell = "R3"
'*** end header info *****************************************
'*** employee line item **************************************
emp.setName = cell.value
emp.setNameCell = cell.Address
emp.setClassCode = cell.Offset(0, 1)
emp.setClassCodeCell = cell.Offset(0, 1).Address
emp.setHourlyRate = cell.Offset(0, 2)
emp.setHourlyRateCell = cell.Offset(0, 2).Address
emp.setCertNumber = cell.Offset(0, 3)
emp.setCertNumberCell = cell.Offset(0, 3).Address
emp.setCommissary = cell.Offset(0, 46)
emp.setCommissaryCell = cell.Offset(0, 46).Address
emp.setTotalCommissary = cell.Offset(0, 46)
emp.setTotalCommissaryCell = cell.Offset(0, 46).Address
emp.setDay = cell.Offset(0, 51)
emp.setEDayCell = cell.Offset(0, 51).Address
emp.setMonth = cell.Offset(0, 52)
emp.setEMonthCell = cell.Offset(0, 52).Address
emp.setYear = cell.Offset(0, 53)
emp.setEYearCell = cell.Offset(0, 52).Address
emp.setchequeNo = cell.Offset(0, 54)
emp.setChequeNoCell = cell.Offset(0, 54).Address
emp.setAddress1 = cell.Offset(0, 57)
emp.setAAddress1Cell = cell.Offset(0, 57).Address
emp.setAddress2 = cell.Offset(1, 57)
emp.setAddress2cell = cell.Offset(1, 57).Address
'*** end employee line item *********************************
'*************footer info ***********************************
emp.setPreparedBy = Sheets("EFF_PAYROLL").Range("J39").value
emp.setPreparedByCell = Sheets("EFF_PAYROLL").Range("J39").Address
emp.setAuthorizedOfficer = Sheets("EFF_PAYROLL").Range("AE39").value
emp.setAuthorizedOfficerCell = Sheets("EFF_PAYROLL").Range("AE39").Address
emp.setPrintedName = Sheets("EFF_PAYROLL").Range("AD44").value
emp.setPritnedNameCell = Sheets("EFF_PAYROLL").Range("AD44").Address
'*************end footer info *******************************
employeeCollection.Add emp
' For Each emp In employeeCollection
' Debug.Print emp.getID & " " & emp.getName _
' ; vbCrLf & emp.getClassCode & " " _
' ; emp.getClassCodeCell
'
'
' Next emp
'
'
' Debug.Print employeeCollection.Count
'
'++++++++++++++++++++++++++++++++++++++
'END fetch of data from payroll_journal
'++++++++++++++++++++++++++++++++++++++
' If Not IsEmpty(cell.value) And errorFlag = False Then
'
'
'
' 'unprotect worksheets during writing process
' unProtectWS ("Cheque Template")
'
' ' unprotect workbook
' ActiveWorkbook.Unprotect ("***")
'
'
' Sheets("Cheque Template").Copy After:=Sheets(Sheets.Count)
' ActiveSheet.name = emp.name
'
'
'
'
' '******
' '** populate cheque with corresponding values - cell.Value
' '******
' 'Sheets(employee_name).Range("B7").Value = employee_name
' Sheets(emp.name).Range("B7").value = emp.name
'
'
' Sheets(emp.name).Range("D4").value = dayStr
' Sheets(emp.name).Range("C4").value = monthStr
' Sheets(emp.name).Range("B4").value = emp.year
' Sheets(emp.name).Range("H8").value = emp.certNumber
'
' Sheets(emp.name).Range("B8").value = emp.address1
' Sheets(emp.name).Range("B9").value = emp.address2
'
' 'journal number
' Sheets(emp.name).Range("H4").value = emp.year
' Sheets(emp.name).Range("I4").value = emp.region
' Sheets(emp.name).Range("J4").value = emp.district
' Sheets(emp.name).Range("K4").value = emp.journalNumber
' 'end journal number
'
' Sheets(emp.name).Range("B14").value = emp.regRate
' Sheets(emp.name).Range("F14").value = emp.regHours
'
' 'overtime hours and rate
' Sheets(emp.name).Range("B16").value = emp.overtimeRate
' Sheets(emp.name).Range("F16").value = emp.overtimeHours
' 'END overtime hours and rate
'
' Sheets(emp.name).Range("H14").value = emp.regTotal
' Sheets(emp.name).Range("H16").value = emp.overtimeTotal
' Sheets(emp.name).Range("B24").value = emp.commissary
' Sheets(emp.name).Range("H24").value = emp.totalCommissary
' Sheets(emp.name).Range("H18").value = emp.vacationTotal
' Sheets(emp.name).Range("H20").value = emp.totalPay
' Sheets(emp.name).Range("H29").value = emp.netPay
'
' 'cheque printout (bottom)
' Sheets(emp.name).Range("B47").value = emp.name
' Sheets(emp.name).Range("B48").value = emp.address1
' Sheets(emp.name).Range("B49").value = emp.address2
' Sheets(emp.name).Range("B43").value = Module3.SpellNumber(emp.netPay)
' Sheets(emp.name).Range("K45").value = Round(emp.netPay, 2)
'
' 'month and str on cheque portion
' Sheets(emp.name).Range("K40").value = emp.year & "/" & monthStr & "/" & dayStr
'
' 'printed name aka persons that approves cheque
' Sheets(emp.name).Range("J51").value = emp.printedName
'
'
'
'
'
'
' 'For Each emp In employeeCollection
' ' Perform validation on that employee
' ' Debug.Print emp.Name
' 'Next emp
'
'
'
'
'
'
'
'
'
'
' 'Module6.printWorksheet (emp.name)
' 'Module6.deleteWorksheet (emp.name)
'
'
'
' 'protect/lock cheque template before closing
'
' 'protectWS ("EFF_PAYROLL")
' protectWS ("Cheque Template")
'
' 'protect/lock workbook before closing
' ActiveWorkbook.Protect ("***")
'
' 'add employee to collection - used for later use
' 'employeeCollection.Add emp
'
'
' 'MsgBox "Cheque(s) will be printed."
'
'
' End If
Next cell
Next row
emp.validate
Exit Sub
End Sub
I notice in your code you have some lines commented out that previously appeared to have protected/unprotected the worksheet. If the sheet is still in a protected state, you will not be able to do this operation, and it will raise the 1004 error.
Solution
Unprotect the sheet (manually or via code) before formatting the cell.
OR, in the protection dialog, ensure that users are allowed to format cells: