I would like to apply an attribute, (e.g. <DebuggerBrowsable(DebuggerBrowsableState.Never)>) to all private fields in a class.
How can I accomplish this with PostSharp?
I have tried applying the following aspect to the classes, but without success.
<MulticastAttributeUsage(MulticastTargets.Class)>
<Serializable>
Public Class DebuggerBrowsableHidePrivateMembersAttribute
Inherits TypeLevelAspect
Implements IAspectProvider
Public Iterator Function ProvideAspects(targetElement As Object) As IEnumerable(Of AspectInstance) Implements IAspectProvider.ProvideAspects
Dim targetType = targetElement.GetType
Dim aspect = New CustomAttributeIntroductionAspect(New ObjectConstruction(targetType, DebuggerBrowsableState.Never))
For Each field In targetType.GetFields(BindingFlags.NonPublic Or BindingFlags.DeclaredOnly)
Yield New AspectInstance(field, aspect)
Next
End Function
End Class
I ended up using the following aspect:
Imports PostSharp.Aspects
Imports PostSharp.Extensibility
Imports PostSharp.Reflection
<MulticastAttributeUsage(MulticastTargets.Field Or MulticastTargets.Property)>
Public NotInheritable Class DebuggerBrowsableHideMembersAttribute
Inherits LocationLevelAspect
Implements IAspectProvider
'Hides the following members from browsable debugger windows.
' Private Fields
' Protected Fields
' Static (Shared) Fields
' Private Properties
' Protected Properties
' Static (Shared) Properties
' Indexed Properties
Private Shared ReadOnly Aspect As New CustomAttributeIntroductionAspect(New ObjectConstruction(GetType(DebuggerBrowsableAttribute), DebuggerBrowsableState.Never))
Public Iterator Function ProvideAspects(targetElement As Object) As IEnumerable(Of AspectInstance) Implements IAspectProvider.ProvideAspects
Dim location = DirectCast(targetElement, LocationInfo)
Select Case location.LocationKind
Case LocationKind.Field
Dim info = location.FieldInfo
If info.IsPrivate OrElse info.IsFamily OrElse info.IsStatic Then
Yield New AspectInstance(location.FieldInfo, Aspect)
End If
Case LocationKind.Property
Dim info = location.PropertyInfo.GetMethod
If info.IsPrivate OrElse info.IsFamily OrElse info.IsStatic OrElse info.GetParameters.Count > 0 Then
Yield New AspectInstance(location.PropertyInfo, Aspect)
End If
End Select
Exit Function
End Function
End Class
Related
is there way how to make class working similar to Arrays?
Let's say, I have Class (e.g. Workers) where main property is array of the Workers, nothing else.
Then I'm filling the class as follows
Dim wks as new Workers
wks.add("Worker1")
wks.add("Worker2")
wks.add("Worker3")
Then in Workers Class module:
Private Workers as Variant
Public Function add(ByVal val As Variant) As Long
ReDim Preserve Workers(LBound(Workers) To UBound(Workers) + 1)
Workers(UBound(Workers)) = val
add = UBound(Workers) - LBound(Workers) +1
End Function
Workers representation -> {"Worker1", "Worker2", "Worker3"}
Then I want to access Worker by its index. I know, how to access it by e.g wks.getWorker(1) but what I want to do, is to access it directly by wks(1) which should return "Worker 1". Example above looks, that usual Array or Collection can be used, but I have many internal methods done, only what I'm missing is to access Workers property to read/write directly by its index number.
Is it possible?
Edit
After transfer to Collections, Class looks like:
Option Explicit
Private Workers As Collection
Private Sub Class_Initialize()
Set Workers = New Collection
End Sub
Public Function add(ByVal val As Variant) As Long
Workers.add val
End Function
Public Property Get Item(Index As Integer) As Variant
Item = Workers(Index)
End Property
Public Property Set Item(Index As Integer, Value As Variant)
Workers.Remove Index
Workers.add Value, Before:=Index
End Property
with hidden attributes Attribute Item.VB_UserMemId = 0 at Getter and Setter.
Getting works fine:
Dim wks As New Workers
wks.add "Worker1"
wks.add "Worker2"
wks.add "Worker3"
Debug.Print wks(2) ' <-- OK here
'wks(2) = "Second Worker" ' <-- By debugging this go to Getter not Setter and after Getter is done, it allerts with Runtime error '424': Object required
Set wks(2) = "Second Worker" ' <-- This alert immediately Compile error: Object required on "Second Worker" string
Debug.Print wks(2)
Prints "Worker2" into console, thanks for this, but still I'm not able to set a new value to the required Index of the Workers Collection.
You could use a default member in VBA. Though you can't make the default memeber directly through VBA editor, but you can use any text editor.
Export your class from VBA editor, i.e. File->Export File
Open your exported class in Notepad (or any text editor)
Add this attribute line on your method or property you want to make it default. Attribute Item.VB_UserMemId = 0
You can for example make getWorker default member as.
Public Function GetWorker(Index As Integer) As Worker
Attribute Item.VB_UserMemId = 0
GetWorker = Workers(Index)
End Function
you can then use it like.
Set wk = wks(1)
Here is some detail about default members
http://www.cpearson.com/excel/DefaultMember.aspx
Edits
An example to make Getter/Setter as default member
Public Property Get Item(Index as Integer) as Worker
Attribute Item.VB_UserMemId = 0
Set Item = Workers(Index)
End Property
Public Property Set Item(Index as Integer, Value as Worker)
Attribute Item.VB_UserMemId = 0
Set Workers(Index) = Value
End Property
I tried to implement a new class that is implementing two interfaces in Excel VBA but I have compilation problems as the members of the interfaces do not seem to be properly implemented in the implementing class (they are not callable).
The Interfaces are the following:
ICrawlable:
Option Explicit
Public Function GetCrawler() As ICrawler
End Function
IEquatable:
Option Explicit
Public Function Equals(CompareObject As Variant) As Boolean
End Function
Whereas ICrawlable also holds a function returning the interface ICrawler:
Option Explicit
Public Property Get CurrentItem() As Variant
End Property
Public Sub MoveNext()
End Sub
Public Function GetNext() As Variant
End Function
Public Function ItemsLeft() As Boolean
End Function
I created a sample class InterfaceTester using those two first interfaces:
Option Explicit
Implements ICrawlable
Implements IEquatable
Private Function ICrawlable_GetCrawler() As Variant
End Function
Private Function IEquatable_Equals(CompareObject As Variant) As Boolean
End Function
When trying to use that class in a Module or wherever else I do not have Intellisense support. Furthermore, the code does not compile and I get a "Method or Data member not found" in this module code highlighting the .Equals:
Sub TestInterfacing()
Dim TestInstance As InterfaceTester
Set TestInstance = New InterfaceTester
Dim VerificationInstance As InterfaceTester
Set VerificationInstance = New InterfaceTester
Dim Result As Boolean
Result = TestInstance.Equals(VerificationInstance)
End Sub
Is this a bug in VBA? Have I declared things in the interfaces that are not allowed (I have tried changing all return data types to Variant already and have tried disabling each of the functions of the interfaces)? Do I use reserved keywords (in the object explorer I do not see duplicates of my interface names)?
Does it compile on your machines?
If you want to use methods from the interface, your variable must be declared as this interface type:
Sub TestInterfacing()
Dim TestInstance As IEquatable 'InterfaceTester
Set TestInstance = New InterfaceTester
Dim VerificationInstance As InterfaceTester
Set VerificationInstance = New InterfaceTester
Dim Result As Boolean
Result = TestInstance.Equals(VerificationInstance)
End Sub
However, in this case you cannot use methods from the second interface implemented by this class: ICrawlable.
The reason for this is that in VBA implementing method looks like that:
Private Function ICrawlable_GetCrawler() As ICrawler
while using the rules from other languages it should look like below:
Public Function GetCrawler() As ICrawler
VBA would not understand that this is implementation of interface's method GetCrawler.
In order to overcome this issue you should add another two public methods to InterfaceTester class - Equals and GetCrawler. Implementing methods should only direct to those methods:
InterfaceTester class:
Implements ICrawlable
Implements IEquatable
Public Function Equals(CompareObject As Variant) As Boolean
'implementation
End Function
Public Function GetCrawler() As ICrawler
'implementation
End Function
Private Function ICrawlable_GetCrawler() As ICrawler
Set IEquatable_Equals = GetCrawler
End Function
Private Function IEquatable_Equals(CompareObject As Variant) As Boolean
IEquatable_Equals = Equals(CompareObject)
End Function
Now you can declare your variable TestInstance as InterfaceTester class and use methods from both interfaces.
I am a beginner at excel VBA OOP and need help putting a class instance with a property into the property of another class. I have a way which makes sense to me but does not work. I'm not sure if its just a simply syntax/structure error, or if I'm missing the mark on this entirely. Here is a simplified example which illustrates my problem:
Class A has a property with a string value.
Class B has a property that holds an instance of Class A, and this property takes a string parameter and passes it to Class A's property.
Class A
Private strProp As String
Public Property Let Prop(sProp As String)
strProp = sProp
End Property
Class B
Private clsA As New ClassA
'''DIFFERENT ATTEMPTS OF THE SAME METHOD:
Public Property Let ClassA(strNameA As String)
clsA.Prop = strNameA
End Property
'Public Property Set ClassA(strNameA As String)
' clsA.Prop = strNameA
'End Property
'Public Property Set ClassA(strNameA As String)
'
' Dim xClsA As ClassA
' Set xClsA = New ClassA
'
' xClsA.name = "Foobar"
' clsA = xClsA
'
'End Property
'
Public Function message()
msgbox(clsA.Prop)
End Function
Module (the classes in action)
dim xClassB as ClassB
set xClassB = new ClassB
xClassB.ClassA("Foobar")
xClassB.message 'should display Foobar
the error I get:
"I still get a compile error: definitions of property procedure for the same property are inconsistent or property procedure has an optional parameter, a ParaArray, or an invalid set final parameter"
Class A
Private strProp As String
Public Property Let Prop(sProp As String)
strProp = sProp
End Property
Public Property Get Prop() As String
Prop = strProp
End Property
ClassB:
Private clsA As New ClassA
Public Property Set ClassA(strNameA As String)
clsA.Prop = strNameA
End Property
Public Function message()
msgbox(clsA.Prop)
End Function
...and add a Get for Prop in ClassA
I'm losing quite some time copy-pasting identical properties and methods in various vba custom object I'm building. How do I create an custom-object hierarchy in VBA so one object and inherit properties and methods from others.
In python I would prob write something like:
Class Car(Object)
whatever
Class SlowCar(Car)
inherit whatever
Class FastCar(Car)
inherit whatever
tks in advance.
If i understand what you're saying, this can be done via the Class Module.
From the VBA Editor, select Insert > Class Module
Change the name of the class Module to whatever you want (Car for
example) via the Properties Window (press F4 to make it appear if it
does not already)
Now that you've created your class module you can define its variables and/or properties. The example below would go into your Car Class Module creates a object that holds a car name and a speed
Private carName As String
Private carSpeed As Integer
' Car Name
Public Property Get Name() As String
Name = carName
End Property
Public Property Let Name(result As String)
carName = result
End Property
' Car Speed
Public Property Get Speed() As Integer
Speed = carSpeed
End Property
Public Property Let Speed(result As Integer)
carSpeed = result
End Property
Then from your Module, you can do the following
Sub CreateMyCars()
Dim slowCar as Car
Dim fastCar as Car
Set slowCar = New Car
Set fastCar = New Car
slowCar.Name = "GoKart"
slowCar.Speed = 35
fastCar.Name = "Ferarri"
fastCar.Speed = 185
End Sub
VBA supports inheritance through the use of Interfaces, but they only "inherit" the signature of methods, not the implementation.
A way to reuse an object implementation would be through composition.
Class Car(Object)
whatever
Class SlowCar(Car)
Implements Car
private mCar as Car
Private Sub Class_Initialize
set mCar = new Car
End Sub
Private Sub Car_whatever
Call mCar.whatever
End Sub
And same for FastCar.
I have been asked to modify an Excel sheet with some arcaic programming. I have decided to rewrite it rather then modify all of the many GOTO statments and static arrays. My background is in C# so it has been a bit of a challenge (note: I am sure the naming convention is bad, I am used to being able to use underscore to define private variables)
I am having trouble inializing an attribute of the type dictionary within a class that I have in a VBA application.
The shortened version of the class looks like this
Private pTerminalCode As String
Private pTerminalName As String
...... other attributes
Private pPayRoll As Dictionary
'Propeties
Public Property Get terminalCode() As String
terminalCode = pTerminalCode
End Property
Public Property Let terminalCode(Value As String)
pTerminalCode = Value
End Property
....... more properties
Public Property Get headCount() As Dictionary
headCount = pHeadCount
End Property
Public Property Let headCount(Value As Dictionary)
pHeadCount = Value
End Property
When I try to use the following I get the error "Argument not optional" within the Get property of the headCount() attribute.
Private Function PopulateTerminal()
Dim terminal As clsTerminal
Set terminal = New clsTerminal
terminal.terminalCode = "Wil"
terminal.headCount.Add "Company", 100
End Function
I assume somewhere I need to inialize the dictionary (i.e. = New Dictionary) however I am strugling with where to place it. In C# I do this in the constructor without issue, not sure what to do here.
Thanks
You can do it in the constructor of the VBA class, like so:-
Public Sub Class_Initialize()
Set myDictionary = New Dictionary
End Sub
Don't forget to always use the Set keyword when assigning an object reference, e.g.:-
Public Property Get Foo() As Dictionary
Set Foo = myDictionary
End Sub