Für dieses Tutorial sind Grundkentnisse zum Thema “Objekte in VB” von erforderlich.

Ich habe für dieses Tutorial eine Klasse “Counter” geschrieben (vollständiger Code am Ende des Tutorials). Sie dient hier als Besipiel. Mit einem Objekt der Klasse Counter kann man den Start und die Schrittgrösse definieren und dann Schritt für Schritt weiterzählen. Ich habe aber einige Interessante Details eingebaut.

Der Counter hat für die klassiache Anwendung die folgenden Methoden:

Spezielle Methoden/Property, auf die ich eingehen möschte

Ich zeige mit verschiedenen Testscripts gewisse Funktionalitäten. Bei interessanten Sachen gehe ich dann noch auf den Code in der Klasse ein

Hier mal die Standardfunktionalität, wie man sie aus OOP unter VB kennt.

testDefault

'/**
' * Standardanwendung mit Standardwerten
' */
Public Sub testDefault()
    Debug.Print "--- testDefault() ---"
 
    Dim cnt As New Counter
 
    Debug.Print "default", cnt.current, cnt.toNext, cnt.toNext, cnt.toNext
End Sub

--- testDefault() ---
default        0             1             2             3 

Ich habe der Klasse eine Methode namens initialze() gegeben. Damit lassen sich die Startwerte festlegen und alles andere zurücksetzen

initialize

'/**
' * Setzt die StartWerte für eine Instanz
' * @param  Long        StartWert
' * @param  Long        Schrittgrösse
' * @return Counter     Die Singleton-Instanz
'*/
Public Sub initialize(Optional ByVal iStart As Long = C_DEFAULT_START, Optional ByVal iStep As Long = C_DEFAULT_STEP)
    ...
End Sub

Und zum Testen setze ich einen anderen Startwert und eine andere Schrittgrösse

testWithInitialize

'/**
' * Standard, aber mit anderen Startwert und Schrittgrösse
' */
Public Sub testWithInitialize()
    Debug.Print "--- testWithInitialize() ---"
 
    Dim cnt As New Counter
    cnt.initialize 10, 5
 
    Debug.Print "initialize()", cnt.current, cnt.toNext, cnt.toNext, cnt.toNext
End Sub

--- testWithInititalze() ---
initialize()   10            15            20            25 

Wenn wir die Klasse exportieren und mit einem Texteditor betrachten, dann sehen wir am Anfang der Datei den folgenden Header

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Counter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Standardmässig ist der Eintrag VB_PredeclaredId aus False. Diesen habe ich im Texteditor auf True umgestellt. Wenn ich jetzt die Klasse wieder importiere, dann hat sich das Verhalten ein wenig geändert. Ich kann jetzt Direkt auf die Methoden der Klasse zugreifen, ohne dass ich eine Instanz besitze. Das macht nur beschränkt Sinn. Aber so kann man verschieden Instance() Funktionen schreiben, die ein Objekt der Klasse zurückgeben

Ich hbae 2 Methoden dazu geschrieben. instance() und copyOf(). Beide geben eine neue Instanz des Counters zurück

instance

'/**
' * Eine neue Instanz der Klasse. Ist auch als Default definiert
' * @param  Long        StartWert
' * @param  Long        Schrittgrösse
' * @return Counter     Die Singleton-Instanz
'*/
Public Function instance(Optional ByVal iStart As Long = C_DEFAULT_START, Optional ByVal iStep As Long = C_DEFAULT_STEP) As Counter
    Set instance = New Counter
    instance.initialize iStart, iStep
End Function

copyOf

'/**
' * Eine neue Instanz der Klasse welche die Settings eines anderen Counters übernimmt
' * @param  Counter     StartWert
' * @return Counter     Die Singleton-Instanz
'*/
Public Function copyOf(ByRef iCounter As Counter) As Counter
    Set copyOf = New Counter
    copyOf.initialize iCounter.start, iCounter.step
End Function

Und so kann man diese Methoden anwenden

testWithInstance

'/**
' * Test mit Instance. instance() wird direkt auf der Klasse aufgerufen, nicht aus einem Objekt
' */
Public Sub testWithInstance()
    Debug.Print "--- testWithInstance() ---"
 
    Dim cnt As Counter
    Set cnt = Counter.instance(, 3)
 
    Debug.Print "instance()", cnt.current, cnt.toNext, cnt.toNext, cnt.toNext
End Sub

--- testWithInstance() ---
instance()     0             3             6             9 

Und noch ein Test mit beiden Methoden

testWithInstanceAndCopyOf

'/**
' * Test mit Instance und copyOf
' */
Public Sub testWithInstanceAndCopyOf()
    Debug.Print "--- testWithInstanceAndCopyOf() ---"
 
    Dim cnt1 As Counter
    Dim cnt2 As Counter
 
    Set cnt1 = Counter.instance(, 3)
    Debug.Print "instance()", cnt1.current, cnt1.toNext, cnt1.toNext, cnt1.toNext
 
    Set cnt2 = Counter.copyOf(cnt1)
    Debug.Print "copyOf()", cnt2.current, cnt2.toNext, cnt2.toNext, cnt2.toNext
 
End Sub

--- testWithInstanceAndCopyOf() ---
instance()     0             3             6             9 
copyOf()       0             3             6             9 

Eine Funktion will ich als Standard setzen. Dass bedeutet, dass diese Funktion aufgerufen wird, wenn man die Klasse mit () startet, gleich eine bestimmte Funktion ausgeführt wird. In diesem Fall habe ich die Funktion instance() gewählt

Dazu setze ich das Attribut VB_UserMemId der Funktion auf 0. Dass muss man auch Ausserhalb des VBA-Editors mit einem Texteditor machen, da auch dieses Setting versteckt ist.

Public Function instance(Optional ByVal iStart As Long = C_DEFAULT_START, Optional ByVal iStep As Long = C_DEFAULT_STEP) As Counter
Attribute instance.VB_UserMemId = 0
'Attribute instance.VB_UserMemId = 0
    ...
End Function

Die 2te Zeile mit dem Komentar habe ich immer dabei. Wenn ich die Funktion anpasse kann es vorkommen, dass die versteckte Zeile rausfällt. Das merkt mann dann, wenn bei der Anwendung ein Fehler kommt. Einfach die Funktion wieder exportieren, die den Text der Komentarzeile nach oben kopieren und die Klasse wieder importieren

Und so wendet man das dann an

testWithUserMemId0

'/**
' * Test mit Instance. instance() wird direkt auf der Klasse aufgerufen, nicht aus einem Objekt
' */
Public Sub testWithUserMemId0()
    Debug.Print "--- testWithUserMemId0() ---"
 
    Dim cnt As Counter
    Set cnt = Counter(99, -3)
 
    Debug.Print "()", cnt.current, cnt.toNext, cnt.toNext, cnt.toNext
End Sub

--- testWithUserMemId0() ---
()             99            96            93            90 

Manchmal hat man eine Klasse, die eine Liste mitverwaltet. Diese will mit For Each durchiterieren. Dazu verwende ich wieder das versteckte Funktionsattribut VB_UserMemId. Dieses mal aber mit dem Wert 4 Zudem muss ich eine ganz Bestimmte Funktion bauen. Sie heisst NewEnum()

NewEnum

'/**
' * Der NewEnum wird für die For Each.. Next Schleife verwendet
' *
' * Diese Funktion hat das Attribut "'Attribute NewEnum.VB_UserMemId = -4"
' * !! Diese Iterierung hat keinen Einfluss auf die aktuelle Position !!
' *
' * @return Das nächste element
' */
Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
'Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = pNewEnum.[_NewEnum]
End Function

Darin komm das Objekt pNewEnum vor. Das ist eine Collection. Diese beinhaltet alle Werte, die man mit For Each herauslesen kann.

Private pNewEnum        As Collection

In diesem Fall einfach alle Werte, die der Counter hatte. Das wird in der Funktion toNext der Collection hinzugefügt

pNewEnum.add pCurrent

Jetzt habe ich also eine Collection, in der alle Einträge gespeichert sind, die durchiteriert wurden.

Machen wir mal ein Beispiel um zu zeige, wei man das anwenden kann

testWithNewEnum

'/**
' * Test mit toMax und NewEnum
' */
Public Sub testWithNewEnum()
    Debug.Print "--- testWithNewEnum() ---"
 
    Dim cnt As New Counter
    Dim i As Long
    Dim nr As Variant
    'Cointer initializieren
    cnt.initialize 271, 333
 
    'Weiterzählen bis Maximum 2000
    Do
    Loop While (cnt.toNext + cnt.step) < 2000
 
    'und mal schauen, was für Werte der Counter bereits hinter sich hat
    For Each nr In cnt
        Debug.Print nr
    Next nr
End Sub

--- testWithNewEnum() ---
 271 
 604 
 937 
 1270 
 1603 
 1936 

Dank dem Attribute VB_PredeclaredId = True ist die Klasse auch Singelton fähig. Sie ist also immer auch eine Instanz von sich selber. Dazu kann ich einfach den Klassennamen nehmen und die Methoden aufrufen. Aber Achtung

Counter.toNext		'Zählt den Singelton-Counter hoch
Counter().toNext	'Erstellt eine neue Instanz (instance()) und zählt diese um eines hoch

Der Vorteil der Singelton ist, dass sie von überall her die Werte behält. Auch wenn wie die Singelton einem Objekt zugeordnet wird, so ist das Objekt mit der Singelton weiterhin verknüpft.

'/**
' * Erster Test mit Singelton
' */
Public Sub testWithSingleton1()
    Debug.Print "--- testWithSingleton1 ---"
    'Sigelton zurücksetzen
    Counter.initialize
    Debug.Print "singleton 1", Counter.current, Counter.toNext, Counter.toNext, Counter.toNext
End Sub
 
'/**
' * weiterführende Test mit Singleton
' */
Public Sub testWithSingleton2()
    Debug.Print "--- testWithSingleton2 ---"
 
    Debug.Print "singleton 2", Counter.current, Counter.toNext, Counter.toNext, Counter.toNext
 
    Debug.Print "Der Sigelton neue Werte zuweisen"
    Counter.initialize 1000, -5
    Debug.Print "singleton 3", Counter.current, Counter.toNext, Counter.toNext, Counter.toNext
 
    Debug.Print "Eine Referenz der Sigelton als Objekt verwenden"
    Dim cnt As Counter
    Set cnt = Counter
    Debug.Print "singleton 4", cnt.current, cnt.toNext, cnt.toNext, cnt.toNext
 
    Debug.Print "Auswirkungen des Objektes auf die referenzierte Sigelton"
    Debug.Print "singleton 5", Counter.current, Counter.toNext, Counter.toNext, Counter.toNext
End Sub

--- testWithSingleton1 ---
singleton 1    0             1             2             3 
--- testWithSingleton2 ---
singleton 2    3             4             5             6 
Der Sigelton neue Werte zuweisen
singleton 3    1000          995           990           985 
Eine Referenz der Sigelton als Objekt verwenden
singleton 4    985           980           975           970 
Auswirkungen des Objektes auf die referenzierte Sigelton
singleton 5    970           965           960           955 

counter.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Counter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------
'File         : Counter.cls
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/
'Version      : 1.0.0
'Name         : Counter
'Author       : Stefan Erb (ERS)
'History      : 05.04.2017 - ERS - Creation
'-------------------------------------------------------------------------------
Option Explicit
 
Const C_DEFAULT_START = 0
Const C_DEFAULT_STEP = 1
 
Private pStart          As Long
Private pCurrent        As Long
Private pStep           As Long
Private pNewEnum        As Collection
 
'-------------------------------------------------------------------------------
' -- Public Constructors
'-------------------------------------------------------------------------------
 
'/**
' * Eine neue Instanz der Klasse. Ist auch als Default definiert
' * @param  Long        StartWert
' * @param  Long        Schrittgr�sse
' * @return Counter     Die Singleton-Instanz
'*/
Public Function instance(Optional ByVal iStart As Long = C_DEFAULT_START, Optional ByVal iStep As Long = C_DEFAULT_STEP) As Counter
Attribute instance.VB_UserMemId = 0
'Attribute instance.VB_UserMemId = 0
    Set instance = New Counter
    instance.initialize iStart, iStep
End Function
 
'/**
' * Eine neue Instanz der Klasse welche die Settings eines anderen Counters �bernimmt
' * @param  Counter     StartWert
' * @return Counter     Die Singleton-Instanz
'*/
Public Function copyOf(ByRef iCounter As Counter) As Counter
    Set copyOf = New Counter
    copyOf.initialize iCounter.start, iCounter.step
End Function
 
'-------------------------------------------------------------------------------
' -- Public Methodes
'-------------------------------------------------------------------------------
 
'/**
' * Setzt die StartWerte f�r eine Instanz
' * @param  Long        StartWert
' * @param  Long        Schrittgr�sse
' * @return Counter     Die Singleton-Instanz
'*/
Public Sub initialize(Optional ByVal iStart As Long = C_DEFAULT_START, Optional ByVal iStep As Long = C_DEFAULT_STEP)
    pStart = iStart
    pCurrent = iStart
    pStep = iStep
    Set pNewEnum = New Collection
    pNewEnum.add iStart
End Sub
 
'-------------------------------------------------------------------------------
' -- COLLECTION METHODES ---
' http://msdn.microsoft.com/en-us/library/aa262338%28v=vs.60%29.aspx
'-------------------------------------------------------------------------------
 
'/**
' * Der NewEnum wird f�r die For Each.. Next Schleife verwendet
' *
' * Diese Funktion hat das Attribut "'Attribute NewEnum.VB_UserMemId = -4"
' * !! Diese Iterierung hat keinen Einfluss auf die aktuelle Position !!
' *
' * @return Das n�chste element
' */
Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
'Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = pNewEnum.[_NewEnum]
End Function
 
'/**
' * Z�hlt um STEP hoch und gibt den neuen Wert zur�ck
' * @return Long
' */
Public Function toNext() As Long
    pCurrent = pCurrent + pStep
    toNext = pCurrent
    pNewEnum.add pCurrent
End Function
 
'/**
' * F�hrt toNext bis zu maximal dem mitgegeben Wert
' * @param  Long
' * @return Long
' */
Public Function toMax(ByVal iMaxValue As Long) As Long
    Do While (toNext + pStep) < iMaxValue
    Loop
    toMax = pCurrent
End Function
 
'/**
' * Setzt alles auf Start zur�ck
' */
Public Sub reset()
    initialize pStart, pStep
End Sub
 
'-------------------------------------------------------------------------------
' -- Public Properties
'-------------------------------------------------------------------------------
 
'/**
' * der Aktuelle Wert
' * @return Long
' */
Public Property Get current() As Long
    current = pCurrent
End Property
 
Public Property Get start() As Long
    start = pStart
End Property
Public Property Get step() As Long
    step = pStep
End Property
 
'-------------------------------------------------------------------------------
' -- Private Events
'-------------------------------------------------------------------------------
 
'/**
' * Initialisiert die Klasse
' */
Private Sub Class_Initialize()
    initialize
End Sub