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:
Related
Public Property Name() As String = "default_name"
Sub InitializeFields()
Name = String.Empty
'
'
'
Name = Name.GetDefaultValue.ToString ' an example
End Sub
Programmatically, how can I revert the default value "default_name" of any property?
Here's an example of how you ought to do this with an actual default value:
Imports System.ComponentModel
Public Class Thing
<DefaultValue("Hello World")>
Public Property WithDefault As String
Public Property WithoutDefault As String
End Class
Imports System.ComponentModel
Imports System.Reflection
Module Module1
Sub Main()
Dim something As New Thing
something.WithDefault = "First"
something.WithoutDefault = "Second"
If TrySetDefaultValue(something, NameOf(something.WithDefault)) Then
Console.WriteLine($"{NameOf(something.WithDefault)} reset to ""{something.WithDefault}""")
Else
Console.WriteLine($"No default value for {NameOf(something.WithDefault)}")
End If
If TrySetDefaultValue(something, NameOf(something.WithoutDefault)) Then
Console.WriteLine($"{NameOf(something.WithoutDefault)} reset to ""{something.WithoutDefault}""")
Else
Console.WriteLine($"No default value for {NameOf(something.WithoutDefault)}")
End If
End Sub
Public Function TryGetDefaultValue([object] As Object, propertyName As String, ByRef value As Object) As Boolean
Dim attribute = [object].GetType().GetProperty(propertyName).GetCustomAttribute(Of DefaultValueAttribute)()
If attribute Is Nothing Then
Return False
End If
value = attribute.Value
Return True
End Function
Public Function TrySetDefaultValue([object] As Object, propertyName As String) As Boolean
Dim [property] = [object].GetType().GetProperty(propertyName)
Dim attribute = [property].GetCustomAttribute(Of DefaultValueAttribute)()
If attribute Is Nothing Then
Return False
End If
Dim value = attribute.Value
[property].SetValue([object], value)
Return True
End Function
End Module
There's no out-of-the-box way to somehow revert a property to its (custom) initial value. Once it's changed, it's over; the original value is lost.
Assuming the property belongs to a class (and that it doesn't get modified in the constructor), you could retrieve the value by creating a temporary instance of the class. For example:
Class SomeClass
Public Property Name As String = "default_name"
Sub InitializeFields()
Name = String.Empty
'
'
'
Name = New SomeClass().Name
End Sub
End Class
However, that's not very robust and could get ugly really fast. The way I would do this is by storing the default value in a constant:
Private Const DefaultName As String = "default_name"
Public Property Name As String = DefaultName
Sub InitializeFields()
Name = String.Empty
'
'
'
Name = DefaultName
End Sub
And then you can do that for each property that you need to later access its original value.
Answering myself:
Imports System.Reflection
Imports System.ComponentModel
Public Class clsThisClass
' each property have attribute of default value
<DefaultValue(0)>
Public Property RecordCount() As Long = 0
<DefaultValue("a")>
Public Property SQL() As String = String.Empty
<DefaultValue(0)>
Public Property IndexID() As Long = 0
<DefaultValue("b")>
Public Property Name() As String = String.Empty
<DefaultValue("c")>
Public Property Title() As String = String.Empty
<DefaultValue("d")>
Public Property Document_No() As String = String.Empty
<DefaultValue("abc")>
Public Property Company_Code() As String = String.Empty
Sub InitializeFields()
With Me
RecordCount = 28
IndexID = 10
Name = "name"
Title = "title"
Document_No = "doc_no"
Company_Code = "com_code"
Debug.WriteLine(RecordCount)
Debug.WriteLine(IndexID)
Debug.WriteLine(Name)
Debug.WriteLine(Document_No)
Debug.WriteLine(Company_Code)
' revert or reset all properties to default value upon initialization
Dim aType As Type = GetType(clsThisClass)
' each property of class
For Each pi As System.Reflection.PropertyInfo In aType.GetProperties()
' grab assigned default value of the property
Dim attribute = Me.GetType().GetProperty(pi.Name.ToString).GetCustomAttribute(Of DefaultValueAttribute)()
Try
Dim value As Object = Nothing
' convert value type according to the type of the property
value = CTypeDynamic(value, GetType(Attribute))
If Not attribute Is Nothing Then
value = attribute.Value
' set default value
pi.SetValue(Me, value)
End If
Catch ex As Exception
End Try
Next
Debug.WriteLine(RecordCount)
Debug.WriteLine(IndexID)
Debug.WriteLine(Name)
Debug.WriteLine(Document_No)
Debug.WriteLine(Company_Code)
End With
End Sub
End Class
Output:
28
10
name
doc_no
com_code
0
0
a
b
c
d
abc
initialized all properties with a default value at once.
in my scenario, I have numerous classes and have several properties.
by doing these few lines of code. I can copy-paste in each class at initializing method. it saved lots of time for writing code.
I have been coding vba for quite sometime now and it is only recently that I have begun diving into doing up some class module.
some questions on my mind is when should I stop including functions and properties in a class ?
i.e. I am creating a class module where by it record table properties (i.e. row of header column) I went on further to create a retrieve data function where it gets data from other table with the same class.
Question 1: am I over doing it? I tend to want to put all the function in one class.
Question 2: if I want to set all classes to have the same default initialization do I declare a public const in the class module itself or the normal modules?
Here is my class module :
Private pHeaderNames As Object
Private pHeaderRow As Long
Private pSubHeaderNames As Object
Private pSubHeaderRow As Long
Private pDataRowStart As Long
Private pInputColStart As Long
Private pTableColStart As Long
Private pHeaderLastCol As Long
Private pTblWorksheet As Worksheet
Private pFileURL As String
Private pFileName As String
'---------------------------------------------- Initialization
Private Sub Class_Initialize()
pHeaderRow = 1
pDataRowStart = 2
pTableColStart = 1
pInputColStart = pTableColStart
pSubHeaderRow = pHeaderRow
pHeaderLastCol = Cells(pHeaderRow, Columns.Count).End(xlToLeft).Column
Set pHeaderNames = CreateObject("Scripting.Dictionary")
Set pSubHeaderNames = CreateObject("Scripting.Dictionary")
End Sub
Public Property Get FileURL() As String
FileURL = pFileURL
End Property
Public Property Let FileURL(Value As String)
pFileURL = Value
End Property
Public Property Get FileName() As String
FileName = pFileName
End Property
Public Property Let FileName(Value As String)
pFileName = Value
End Property
Function OpenWorkbook(URL As String, Name As String)
pFileURL = URL
pFileName = Name
Call Workbook_open(pFileURL, pFileName)
End Function
Public Property Let SetSheet(Value As String)
If pFileName - "" Then
Set pTblWorksheet = ActiveWorkbook.Worksheets(Value)
Else
Set pTblWorksheet = Workbook(pFileName).Worksheets(Value)
End If
End Property
Public Property Get TblWorksheet() As Worksheet
TblWorksheet = pTblWorksheet
End Property
Public Property Let TblWorksheet(Sheet As Worksheet)
pTblWorksheet = Sheet
End Property
'---------------------------------------------- HeaderLastCol
Public Property Get HeaderLastCol() As Long
HeaderLastCol = pHeaderLastCol
End Property
Public Property Let HeaderLastCol(Value As Long)
pHeaderLastCol = Value
End Property
'---------------------------------------------- HeaderRow
Public Property Let HeaderRow(Value As Long)
pHeaderLastCol = Cells(pHeaderRow, Columns.Count).End(xlToLeft).Column
pHeaderRow = Value
End Property
Public Property Get HeaderRow() As Long
HeaderRow = pHeaderRow
End Property
'---------------------------------------------- SubHeaderRow
Public Property Let SubHeaderRow(Value As Long)
pSubHeaderRow = Value
End Property
Public Property Get SubHeaderRow() As Long
SubHeaderRow = pSubHeaderRow
End Property
'---------------------------------------------- InputColStart
Sub SetInputColStart(KEY As Variant)
pInputColStart = pHeaderNames(KEY)
End Sub
Public Property Get InputColStart() As Long
InputColStart = pInputColStart
End Property
Public Property Let InputColStart(Value As Long)
pInputColStart = Value
End Property
'---------------------------------------------- DataRowStart
Public Property Get DataRowStart() As Long
DataRowStart = pDataRowStart
End Property
Public Property Let DataRowStart(Value As Long)
pDataRowStart = Value
End Property
'---------------------------------------------- TableColStart
Public Property Get TableColStart() As Long
TableColStart = pTableColStart
End Property
Public Property Let TableColStart(Value As Long)
pTableColStart = Value
End Property
'---------------------------------------------- HeaderName
Sub GetHeaderNames()
With pHeaderNames
For i = pTableColStart To pHeaderLastCol
If Not .Exists(UCase(Cells(pHeaderRow, i).Value)) Then
.Add UCase(Cells(pHeaderRow, i).Value), i
End If
Next i
End With
End Sub
Function HeaderName(KEY As String)
If pHeaderNames.Exists(KEY) Then
HeaderName = pHeaderNames(KEY)
Else
HeaderName = ""
End If
End Function
Function CountHeaderNames()
CountHeaderNames = pHeaderNames.Count
End Function
Function PrintHeaderObject()
For Each KEY In pHeaderNames.keys
Debug.Print KEY, pHeaderNames(KEY)
Next
End Function
'---------------------------------------------- SubHeaderName
Sub GetSubHeaderNames()
With pSubHeaderNames
For i = pTableColStart To pHeaderLastCol
If Not .Exists(UCase(Cells(pSubHeaderRow, i).Value)) Then
.Add UCase(Cells(pSubHeaderRow, i).Value), i
End If
Next i
End With
End Sub
Function SubHeaderName(KEY As String)
If pSubHeaderNames.Exists(KEY) Then
SubHeaderName = pSubHeaderNames(KEY)
Else
SubHeaderName = "" 'or raise an error...
End If
End Function
Function CountSubHeaderNames()
CountSubHeaderNames = pSubHeaderNames.Count
End Function
Function PrintSubHeaderObject()
For Each KEY In pSubHeaderNames.keys
Debug.Print KEY, pSubHeaderNames(KEY)
Next
End Function
Function RetrieveData(FromSht As Worksheet, ByVal FromTable As cTable)
Dim KEY As String
'CurrentSht = ActiveSheet
For i = pTableColStart To pHeaderLastCol
KEY = Cells(pHeaderRow, i).Value
If FromTable.HeaderName(KEY) = "" Then
GoTo Nexti
Else
With FromSht
.Activate
rD_LastRow = 10
Set Source = .Range(.Cells(FromTable.DataRowStart, FromTable.HeaderName(KEY)), _
.Cells(rD_LastRow, FromTable.HeaderName(KEY)))
End With
With CurrentSht
.Activate
.Range(.Cells(DataRowStart, i), _
.Cells(DataRowStart, i)) _
.Resize(Source.Rows.Count, Source.Columns.Count).Cells.Value = Source.Cells.Value
End With
End If
Nexti:
Next i
End Function
Here is the module, so you can see that I have always need to declare headerRow , subHeaderRow and Datarowstart, even thou I have a default initialization set in the class module, is there away to change the default initialization based on the main module? or I just have to do it in the class module? (I trying to make the class portable)
Sub test()
Dim sht As Worksheet
Set wb = ActiveWorkbook
Set sht = wb.Sheets("Skin(Units)")
With Worksheets("Skin(Units)")
.Activate
Set SkinUnits = New cTable
Debug.Print TypeName(SkinUnits)
SkinUnits.HeaderRow = 1
SkinUnits.SubHeaderRow = 3
SkinUnits.DataRowStart = 4
SkinUnits.GetHeaderNames
SkinUnits.GetSubHeaderNames
SkinUnits.PrintHeaderObject
SkinUnits.PrintSubHeaderObject
SkinUnits.SetInputColStart ("Start")
End With
With Worksheets("Pain(Units)")
.Activate
Set PainUnits = New cTable
PainUnits.HeaderRow = 1
PainUnits.SubHeaderRow = 3
PainUnits.DataRowStart = 4
PainUnits.GetHeaderNames
PainUnits.GetSubHeaderNames
PainUnits.PrintHeaderObject
PainUnits.PrintSubHeaderObject
PainUnits.SetInputColStart ("Start")
Debug.Print PainUnits.HeaderName("SKU")
Debug.Print TypeName(sht), TypeName(SkinUnits)
Call test22222(SkinUnits)
Call PainUnits.RetrieveData(sht, SkinUnits)
End With
End Sub
Function test22222(ByVal X As cTable)
Debug.Print X.HeaderRow
End Function
I'm getting a Type Mismatch-error, when trying to retrieve items from my collection.
What I mainly want to do, is to collect all customers within as collection, and past all results on my ListBox for visualization. The reason why I'm using a class-module is due to the fact, that UDT are pasting an error: "Only user-defined types defined in public object modules can be coerced to or from a variant or passed to late-bound functions". So I started programming all properties in classes instead, but I haven't really worked with classes before, so it's pretty new to me.
I'm facing another issue; the .additem-property is limited to 9 columns (on the ListBox), and therefore I'd like to use another method for this. Array is unlimited, and rowsources are limited to 256 or 255. I'd like 14 columns to be shown on the ListBox, and furthermore have the ability to expand if needed later on.
ListView aren't really an option due to the fact, that many computers doesn't have this reference integrated.
Class-module. "clsCustomers"
Option Explicit
Private cID As String
Private cCustomerName As String
Private cCompanyName As String
Private cFullName As String
Private cCVR As Long
Private cType As String
Private cGroup As String
Private cCountry As String
Private cStreet As String
Private cZipcode As Variant
Private cCity As String
Private cPhoneNum As Long
Private cMobileNum As Long
Private cEmail As String
Private cInvoiceEmail As String
Private cCreationDate As Date
Private cLastChange As Date
Public Property Get customerID() As String
customerID = cID
End Property
Public Property Let customerID(value As String)
cID = value
End Property
Public Property Get customerName() As String
customerName = cCustomerName
End Property
Public Property Let customerName(value As String)
cCustomerName = value
End Property
Public Property Get customerCompanyName() As String
customerCompanyName = cCompanyName
End Property
Public Property Let customerCompanyName(value As String)
cCompanyName = value
End Property
Public Property Get customerFullName() As String
customerFullName = cFullName
End Property
Public Property Let customerFullName(value As String)
cFullName = value
End Property
Public Property Get customerCVR() As Long
customerCVR = cCVR
End Property
Public Property Let customerCVR(value As Long)
cCVR = value
End Property
Public Property Get customerType() As String
customerType = cType
End Property
Public Property Let customerType(value As String)
cType = value
End Property
Public Property Get customerGroup() As String
customerGroup = cGroup
End Property
Public Property Let customerGroup(value As String)
cGroup = value
End Property
Public Property Get customerCountry() As String
customerCountry = cCountry
End Property
Public Property Let customerCountry(value As String)
cCountry = value
End Property
Public Property Get customerStreet() As String
customerStreet = cStreet
End Property
Public Property Let customerStreet(value As String)
cStreet = value
End Property
Public Property Get customerZipcode() As Variant
customerZipcode = cZipcode
End Property
Public Property Let customerZipcode(value As Variant)
cZipcode = value
End Property
Public Property Get customerCity() As String
customerCity = cCity
End Property
Public Property Let customerCity(value As String)
cCity = value
End Property
Public Property Get customerPhoneNum() As Long
customerPhoneNum = cPhoneNum
End Property
Public Property Let customerPhoneNum(value As Long)
cPhoneNum = value
End Property
Public Property Get customerMobileNum() As Long
customerMobileNum = cMobileNum
End Property
Public Property Let customerMobileNum(value As Long)
cMobileNum = value
End Property
Public Property Get customerEmail() As String
customerEmail = cEmail
End Property
Public Property Let customerEmail(value As String)
cEmail = value
End Property
Public Property Get customerInvoiceEmail() As String
customerInvoiceEmail = cInvoiceEmail
End Property
Public Property Let customerInvoiceEmail(value As String)
cInvoiceEmail = value
End Property
Public Property Get customerCreationDate() As Date
customerCreationDate = cCreationDate
End Property
Public Property Let customerCreationDate(value As Date)
cCreationDate = value
End Property
Public Property Get customerLastChange() As Date
customerLastChange = cLastChange
End Property
Public Property Let customerLastChange(value As Date)
cLastChange = value
End Property
Module. "mExtendedCustomerDatabase". Here I collect my customers within the worksheet("CustomerDatabase").
Public CustomerCollection As New Collection
Sub CollectAllCustomers()
Dim tCustomers As clsCustomers
Dim i As Long
Dim wks As Worksheet
Set wks = ThisWorkbook.Worksheets("CustomerDatabase")
For i = 1 To wks.UsedRange.Rows.Count
Set tCustomers = New clsCustomers
With tCustomers
.customerID = "Kunde" & wks.Cells(i, CustomerDatabase.CustomerNumber).value
.customerName = wks.Cells(i, CustomerDatabase.InternRef).value
.customerCompanyName = wks.Cells(i, CustomerDatabase.CompanyName).value
.customerFullName = wks.Cells(i, CustomerDatabase.FirstName).value & wks.Cells(i, CustomerDatabase.LastName).value
.customerCVR = wks.Cells(i, CustomerDatabase.CVR).value
.customerType = wks.Cells(i, CustomerDatabase.customerType).value
.customerGroup = wks.Cells(i, CustomerDatabase.customerGroup).value
.customerCountry = wks.Cells(i, CustomerDatabase.Country).value
.customerStreet = wks.Cells(i, CustomerDatabase.Street).value
.customerZipcode = wks.Cells(i, CustomerDatabase.Zipcode).value
.customerCity = wks.Cells(i, CustomerDatabase.City).value
.customerPhoneNum = wks.Cells(i, CustomerDatabase.PhoneNum).value
.customerMobileNum = wks.Cells(i, CustomerDatabase.MobileNum).value
.customerEmail = wks.Cells(i, CustomerDatabase.Email).value
.customerInvoiceEmail = wks.Cells(i, CustomerDatabase.InvoiceEmail).value
.customerCreationDate = wks.Cells(i, CustomerDatabase.CreationDate).value
.customerLastChange = wks.Cells(i, CustomerDatabase.LastChangeDate).value
CustomerCollection.Add tCustomers, .customerID
End With
Next i
End Sub
Module. "mExtendedCustomerDatabase". Here I'd like to add my whole collection to my ListBox.
Sub FillListBox(sListName As String)
Dim wks As Worksheet
Set wks = ThisWorkbook.Worksheets("CustomerDatabase")
With frm_T1_Kundeoplysninger.Controls.Item(sListName)
.AddItem CustomerCollection.Item("Kunde1") 'Type Mismatch-error
End With
End Sub
To summarize. I'd like some guidelines on the easiest/fastest way to retrieve all items within my collection, and past them into my ListBox. Alternatives ways to do this, are accommodated aswell.
I manage to solve it. Converting my collection to an array, and setting my collection as inputparameter. Looping through my entire collection, and allocating it in an array. The issue seems to be related to .List-function, only allowing arrays as variant-datatype. It was solved; inspired by (http://www.iwebthereforeiam.com/iwebthereforeiam/2004/06/excel-vba-code-to-convert-coll.html).
Sub FillListBox(sListName As String)
With frm_T1_Kundeoplysninger.Controls.Item(sListName)
.List = ConvertCollectionToArray(CustomerCollection)
End With
Clearing:
Set CustomerCollection = Nothing
End Sub
Function ConvertCollectionToArray(cCustomers As Collection) As Variant()
Dim arrCustomers() As Variant: ReDim arrCustomers(0 To cCustomers.Count - 1, 16)
Dim i As Integer
With cCustomers
For i = 1 To .Count
arrCustomers(i - 1, 0) = .Item(i).customerID
arrCustomers(i - 1, 1) = .Item(i).customerName
arrCustomers(i - 1, 2) = .Item(i).customerCompanyName
arrCustomers(i - 1, 3) = .Item(i).customerFullName
arrCustomers(i - 1, 4) = .Item(i).customerCVR
arrCustomers(i - 1, 5) = .Item(i).customerType
arrCustomers(i - 1, 6) = .Item(i).customerGroup
arrCustomers(i - 1, 7) = .Item(i).customerCountry
arrCustomers(i - 1, 8) = .Item(i).customerStreet
arrCustomers(i - 1, 9) = .Item(i).customerZipcode
arrCustomers(i - 1, 10) = .Item(i).customerCity
arrCustomers(i - 1, 11) = .Item(i).customerPhoneNum
arrCustomers(i - 1, 12) = .Item(i).customerMobileNum
arrCustomers(i - 1, 13) = .Item(i).customerEmail
arrCustomers(i - 1, 14) = .Item(i).customerInvoiceEmail
arrCustomers(i - 1, 15) = .Item(i).customerCreationDate
arrCustomers(i - 1, 16) = .Item(i).customerLastChange
Next
End With
ConvertCollectionToArray = arrCustomers
End Function
I'm trying to create a custom property in an excel sheet, then retrieve its value. This is fine when I don't use an empty string, i.e. "". When I use the empty string, I get this error:
Run-time error '7':
Out of memory
Here's the code I'm using:
Sub proptest()
Dim cprop As CustomProperty
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("control")
sht.CustomProperties.Add "path", ""
For Each cprop In ThisWorkbook.Sheets("control").CustomProperties
If cprop.Name = "path" Then
Debug.Print cprop.Value
End If
Next
End Sub
The code fails at Debug.Print cprop.value. Shouldn't I be able to set the property to "" initially?
With vbNullChar it works, sample:
Sub proptest()
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("control")
' On Error Resume Next
sht.CustomProperties.Item(1).Delete
' On Error GoTo 0
Dim pathValue As Variant
pathValue = vbNullChar
Dim pathCustomProperty As CustomProperty
Set pathCustomProperty = sht.CustomProperties.Add("path", pathValue)
Dim cprop As CustomProperty
For Each cprop In ThisWorkbook.Sheets("control").CustomProperties
If cprop.Name = "path" Then
Debug.Print cprop.Value
End If
Next
End Sub
I think from the comments and the answer from Daniel Dusek it is clear that this cannot be done. The property should have at least 1 character to be valid, an empty string just isnt allowed and will give an error when the .Value is called.
So you Add this property with a length 1 or more string and you Delete the property again when no actual value is to be assigned to it.
As already mentioned it is not possible to set empty strings.
An easy workaround is to use a magic word or character, such as ~Empty (or whatever seems proof enough for you):
Dim MyProperty As Excel.CustomProperty = ...
Dim PropertyValue As String = If(MyProperty.Value = "~Empty", String.Empty, MyPropertyValue)
A slightly more expensive workaround but 100% safe is to start all the values of your custom properties with a character that you then always strip off. When accessing the value, systematically remove the first character:
Dim MyProperty As Excel.CustomProperty = ...
Dim PropertyValue As String = Strings.Mid(MyProperty.Value, 2)
You can write an extension to make your life easier:
<System.Runtime.CompilerServices.Extension>
Function ValueTrim(MyProperty as Excel.CustomProperty) As String
Return Strings.Mid(MyProperty.Value, 2)
End Function
Now you can use it like this: Dim MyValue As String = MyProperty.ValueTrim
Use a reversed principle when you add a custom property:
<System.Runtime.CompilerServices.Extension>
Function AddTrim(MyProperties As Excel.CustomProperties, Name As String, Value As String) as Excel.CustomProperty
Dim ModifiedValue As String = String.Concat("~", Value) 'Use ~ or whatever character you lie / Note Strig.Concat is the least expensive way to join two strings together.
Dim NewProperty As Excel.CustomProperty = MyProperties.Add(Name, ModifiedValue)
Return NewProperty
End Function
To use like this: MyProperties.AddTrim(Name, Value)
Hope this helps other people who come across the issue..
Based on the other answers and some trial and error, I wrote a class to wrap a Worksheet.CustomProperty.
WorksheetProperty:Class
Sets and Gets the value of a Worksheet.CustomProperty and tests if a Worksheet has the CustomProperty
VERSION 1.0 CLASS
Attribute VB_Name = "WorksheetProperty"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'#Folder("Classes")
'#PredeclaredId
Option Explicit
Private Type TMembers
Name As String
Worksheet As Worksheet
End Type
Private this As TMembers
Public Property Get Create(pWorksheet As Worksheet, pName As String) As WorksheetProperty
With New WorksheetProperty
Set .Worksheet = pWorksheet
.Name = pName
Set Create = .Self
End With
End Property
Public Property Get Self() As WorksheetProperty
Set Self = Me
End Property
Public Property Get Worksheet() As Worksheet
Set Worksheet = this.Worksheet
End Property
Public Property Set Worksheet(ByVal pValue As Worksheet)
Set this.Worksheet = pValue
End Property
Public Property Get Name() As String
Name = this.Name
End Property
Public Property Let Name(ByVal pValue As String)
this.Name = pValue
End Property
Public Property Get Value() As String
Dim P As CustomProperty
For Each P In Worksheet.CustomProperties
If P.Name = Name Then
Value = P.Value
Exit Property
End If
Next
End Property
Public Property Let Value(ByVal pValue As String)
Delete
Worksheet.CustomProperties.Add Name:=Name, Value:=pValue
End Property
Public Property Get hasCustomProperty(pWorksheet As Worksheet, pName As String) As Boolean
Dim P As CustomProperty
For Each P In pWorksheet.CustomProperties
If P.Name = pName Then
hasCustomProperty = True
Exit Property
End If
Next
End Property
Public Sub Delete()
Dim P As CustomProperty
For Each P In Worksheet.CustomProperties
If P.Name = Name Then
P.Delete
Exit For
End If
Next
End Sub
Usage
I have several properties of my custom Unit class return a WorksheetProperty. It makes it really easy to sync my database with my worksheets.
Public Function hasMeta(Ws As Worksheet) As Boolean
hasMeta = WorksheetProperty.hasCustomProperty(Ws, MetaName)
End Function
Public Property Get Id() As WorksheetProperty
Set Id = WorksheetProperty.Create(this.Worksheet, "id")
End Property
Public Property Get CourseID() As WorksheetProperty
Set CourseID = WorksheetProperty.Create(this.Worksheet, "course_id")
End Property
Public Property Get Name() As WorksheetProperty
Set Name = WorksheetProperty.Create(this.Worksheet, "unit_name")
End Property
Simple Usage
'ActiveSheet has a CustomProperty
Debug.Print WorksheetProperty.hasCustomProperty(ActiveSheet, "LastDateSynced")
'Set a CustomProperty
WorksheetProperty.Create(ActiveSheet, "LastDateSynced").Value = Now
'Retrieve a CustomProperty
Debug.Print WorksheetProperty.Create(ActiveSheet, "LastDateSynced").Value
I have a sp that I added to my linq designer, which generated the result class:
Partial Public Class web_GetTweetsByUserIDResult
Private _userid As Integer
Private _tweetid As Integer
Private _TweeterFeed As String
Public Sub New()
MyBase.New
End Sub
<Global.System.Data.Linq.Mapping.ColumnAttribute(Storage:="_userid", DbType:="Int NOT NULL")> _
Public Property userid() As Integer
Get
Return Me._userid
End Get
Set
If ((Me._userid = value) _
= false) Then
Me._userid = value
End If
End Set
End Property
<Global.System.Data.Linq.Mapping.ColumnAttribute(Storage:="_tweetid", DbType:="Int NOT NULL")> _
Public Property tweetid() As Integer
Get
Return Me._tweetid
End Get
Set
If ((Me._tweetid = value) _
= false) Then
Me._tweetid = value
End If
End Set
End Property
<Global.System.Data.Linq.Mapping.ColumnAttribute(Storage:="_TweeterFeed", DbType:="NVarChar(100)")> _
Public Property TweeterFeed() As String
Get
Return Me._TweeterFeed
End Get
Set
If (String.Equals(Me._TweeterFeed, value) = false) Then
Me._TweeterFeed = value
End If
End Set
End Property
End Class
However, in this one section of code where I am trying to use the "TweeterFeed" member of the result class I am getting the error, "Error 4 'TweeterFeed' is not a member of 'System.Data.Linq.ISingleResult(Of web_GetTweetsByUserIDResult)'."
My code in this section is, :
<WebMethod()> _
Public Function GetTweetsByUserID(ByVal userID As Integer) As List(Of SimpleTweet)
Dim result As New List(Of SimpleTweet)
Dim urlTwitter As String = "https://api.twitter.com/1/statuses/user_timeline.xml?include_entities=true&include_rts=true&screen_name={0}&count=20"
Dim lq As New lqDFDataContext
Dim var = lq.web_GetTweetsByUserID(userID).ToList()
If Not var Is Nothing Then
For Each twitterfeed In var
Dim listURL As String = String.Format(urlTwitter, var.TweeterFeed)
Dim tweetXML As XmlDocument = utils.GetXMLForURL(listURL)
Dim tweetnodelist As XmlNodeList = tweetXML.ChildNodes(1).ChildNodes
For Each node As XmlNode In tweetnodelist
Dim tweet As New SimpleTweet
tweet.CreatedAt = node.SelectSingleNode("created_at").InnerText
tweet.HTMLText = utils.ReturnTextWithHRefLink(node.SelectSingleNode("text").InnerText)
tweet.ID = node.SelectSingleNode("id").InnerText
tweet.Name = node.SelectSingleNode("user/name").InnerText
tweet.ScreenName = node.SelectSingleNode("user/screen_name").InnerText
tweet.Text = node.SelectSingleNode("text").InnerText
tweet.UserID = node.SelectSingleNode("user/id").InnerText
tweet.ProfileImageURL = node.SelectSingleNode("user/profile_image_url_https").InnerText
result.Add(tweet)
Next
Next
End If
Return result
End Function
Does anyone have any idea what is going on? As far as I see "TweeterFeed" is clearly a member of the class, I can't figure out why I would be getting this error.
You're using var.TweeterFeed when you should be using twitterFeed.TweeterFeed. twitterFeed is a result extracted from var which is a sequence of results.
Using a more descriptive variable name than var would probably have made this clearer to you :)
I have this class
Public Class Tamano
Private pWidth As Integer
Private pHeight As Integer
Public Property Width As Integer
Public Property Height As Integer
End Class
I got the compilation error message 'Height' is not a member of 'TamaƱo' in IIS
To fix it, add Set and Get to the properties and it compiles.
Public Class Tamano
Private pWidth As Integer
Private pHeight As Integer
Public Property Width As Integer
Get
Return pWidth
End Get
Set(value As Integer)
pWidth = value
End Set
End Property
Public Property Height As Integer
Get
Return pHeight
End Get
Set(value As Integer)
pHeight = value
End Set
End Property
End Class
This might not be directly related to your question but It might help someone else.