Category: VBA-Code

Mehrstufige abhängige Auswahl

By , 5. November 2024

Vor einiger Zeit stand ich bei einem Programm für die Vereinsmeisterschaft unseres Schützenvereines vor der Aufgabe, die Ergebnisanzeige endlich korrekt zu realisieren. Man sollte folgendes auswählen können:

  1. die Disziplingruppe, also alle Disziplingruppen, Pistole, Gewehr, Flinte, Armbrust etc.
  2. von der Disziplingruppe abhängend die entsprechende Disziplin, also alle Disziplinen, oder einzelne Disziplinen.
  3. die Altersklasse, also alle Klassen, Schüler, Jugend, Junioren, Herren, Damen oder abhängig von der Disziplin Auflageschießen sollen dann Seniorenklassen angezeigt werden. Das ist eine spzielle Eigenart im Deutschen Schützenbund.

Irgendwie dachte ich da spontan an das Portal unseres Landesverbandes, der in der Ergebnisliste genau diese Auswahlmöglichkeit (neben der Vereins- und Schützenauswahl) abbildet. Von da aus war der Schritt, wie konkret die Ergebnisse dargestellt werden sollen, nicht weit, nämlich genau so wie im Webportal.

Also mittels dem Untersuchungs-Werkzeug des Firefox Webbrowsers die Struktur der Darstellung analysiert, teils kopiert teils ergänzt/abgewandelt. Als Ergebnis stand am Schluss eine Prozedur die per Buttonklick aufgerufen wird, welche im ersten Teil in Abhängigkeit der Auswahlen einen SQL-String aufbaut. Eine kleine Schwierigkeit dabei war es die Auswahlen für „Alle …“ zu realisieren.

Gelöst habe ich dies indem ich einen String (strCase) zusammengesetzt habe jeweils aus 1 oder 0 für jede Auswahlmöglichkeit. Also „111“ für den Fall dass alle 3 Auswahlen auf „Alle“ stehen bzw. „000“ falls keine oder eben die Zwischenschritte. Danach habe ich die möglichen Fälle bestimmt die jeweils eine andere Zusammensetzung des SQL-Strings bedingen würden und in einer Select Case Schleife abgearbeitet. Das Ergebnis ist relativ komplex, aber ich denke zumindest die Systematik dahinter kann man relativ einfach verstehen:
Read more »

Kleine Code-Helferlein

By , 4. Februar 2020

Hallo,
heute möchte ich euch ein paar nützliche Code-Listings vorstellen, die mir bestimmte Arbeiten erleichtern.
Zum ersten ist es eine Prozedur, die mir geöffnete Objekte – Formulare oder Berichte – schließt ohne dass ich jedesmal „DoCmd.close acForm, Me.Name“ schreiben muss. Entwickler sind auch nur faule Menschen 🙂
Statt dessen schreibe ich der Einfachheit halber nur:

hide Me

Die Prozedur dazu in einem Modul sieht so aus:

Public Sub hide(ByRef obj As Object)
    If obj.Application.Forms.Count > 0 Then
        DoCmd.Close acForm, obj.Name
    Else
        DoCmd.Close acReport, obj.Name
    End If
End Sub

Das zweite Helferlein betrifft Dialog-Formulare die ich in diesem Zusammenhang dazu verwende um mir vom Anwender ein OK für irgendwas zu holen, sei es um was zu löschen oder sonst irgendwas. Die Function incl. der Deklaration einer globalen Variable in einem Modul sieht dazu wie folgt aus:

Global selectedOK As Boolean

Public Function CheckOK(ByVal cFormName As String, Optional ByVal vValue As Variant) As Boolean
    DoCmd.OpenForm cFormName, , , , , acDialog, vValue
    If selectedOK Then
        selectedOK = False
        CheckOK = True
    End If
End Function

Im aufgerufenen Formular kann ich dann im Form_Load-Ereignis Me.OpenArgs auswerten um z.B. einen bestimmten Text anzuzeigen o.Ä. In obiger Function wird in der If-Abfrage die globale Variable sofort wieder zurückgesetzt, so dass ich mir keine Gedanken machen muss um deren Status. Daher verwende ich auch den Rückgabewert dieser Function zur weiteren Code-Steuerung, und nicht die globale Variable irgendwo in einem Formular, weil eben nur hier ein nur einem einzigen Ort die Globale Variable zurückgesetzt wird.

Bei Klick auf einen Löschen-Button oder OK-Button in dem Dialog-Formular schreibe ich im entsprechenden Click-Ereignis dann nur folgendes:

Private Sub cmdDelete_Click()
    selectedOK = True
    hide Me
End Sub

Der dritte Tipp betrifft ein bestimmtes Sonderzeichen, welches beim Verwenden zu unerwünschten Ergebnissen führen kann. Hast du schon mal versucht folgenden Text in ein Bezeichnungsfeld über die Caption-Eigenschaft zu schreiben:

Me.Bezeichnungsfeld1.Caption = "Meier GmbH & Co. KG"

Man wird schnell feststellen dass Access das &-Zeichen anderst interpretiert. Die Lösung ist schlichtweg das &-Zeichen zu verdoppeln. Doch was wenn man statt mit Texten mit Variablen arbeitet? Jedesmal die Replace()-Funktion bemühen? Das war mir zu umständlich, so ist es zu folgendem Mini-Codelisting gekommen:

Public Function doubleAND(ByVal cValue As String) As String
    doubleAND = Replace(cValue, "&", "&&")
End Function

Jetzt kann ich ganz einfach wie folgt das schreiben:

Me.Bezeichnungsfeld1.Caption = doubleAND(Firmenname)

Das soll es jetzt fürs erste gewesen sein.
Bis dahin
©2020 Andreas Vogt

In Bug-Falle getappt: Registersteuerelement verschieben mit Unterformular

By , 14. Januar 2020

Hallo,
z.Z. arbeite ich an einem Eigenprojekt – einer Belegungssteuerung für die Pension. Dabei bin ich auf ein Problem gestoßen das wohl ein Bug in Access ist, und zwar zumindest der Version 2010 bis zur aktuellen 2019er Version. Der Sachverhalt ist folgender:
Auf einer Seite eines Registersteuerelementes plazierte ich ein Unterformular-Steuerelement, mit Form als Sourceobject. Die Registersteuerelemente stellen in dem Formular eine Box dar, die zusammengeklappt und aufgeklappt werden kann – mit mehreren solcher „Boxen“ die sich dann entsprechend positionieren. Dazu wird die Move() Funktion verwendet.

Den Style-Fehler, den Access nun produziert, ist dieser:
Verschiebe ich ein RegisterControl dann verschiebt sich die Registerseite natürlich mit, und auch das Unterformular-Control. Soweit alles OK.
ABER das Formular innerhalb des Unterformular-Controls bleibt einfach stehen, fällt also sprichwörtlich aus dem Rahmen mit dem es sich mitbewegen sollte.
Kann man sehr leicht reproduzieren. Kollegen habe mir auch bestätigt dass dieses Verhalten in der neuesten Version 2019 ebenso vorhanden ist.

Nun, tun kann man daran nichts, aber es ist gut dass man das weiß. Ich habe es jetzt so gelöst dass ich hier jetzt kein Register einsetze sondern nur das Unterformular-Control und dieses dann hier verschiebe. Zum Testen hab ich euch ein kleines Beispiel gemacht mit mehreren Optionen:
Testdatenbank

Bis dahin
©2020 Andreas Vogt

Ersatz für DLookup() Funktion

By , 11. Januar 2020

Hallo,
über 4 Jahre Pause mit Access Bloggen – doch heute kommt wieder mal ein erstes Lebenszeichen von mir 😉
Es geht um Domänenfunktionen die eigentlich jeder kennt, wie z.B. Dlookup() oder DCount(). Da diese – zumindest in den Access-Versionen bis 2010 welche ich verwende – wenig performant in bezug auf Geschwindigkeit sind gibt es auch seit vielen Jahren Ersatzfunktionen. Ich selbst verwende immer wieder eine Version die mal von Sascha Trowitzsch (siehe MS-Office-Forum.net) erstellt wurde.
Diese liefert genau 1 Diskreten Wert zurück.
Oftmals braucht man aber nicht einer sondern mehrere Feldwerte eines Datensatzes – daher habe ich die Funktion etwas umgestrickt – ich nenne sie jetzt mal DSLookup(), und das sieht dann so aus:

Public Function DSLookup(ByVal Expression As String, ByVal Domain As String, Optional ByVal Criteria As String) As Variant
    Dim strSQL As String
    Dim retArr As Variant
    Dim ExpressionCounter As Long
    Dim i As Long

    ExpressionCounter = UBound(Split(Trim(Expression), ","))
    strSQL = "SELECT " & Expression & " FROM " & Domain
    If Not Criteria = vbNullString Then strSQL = strSQL & " WHERE " & Criteria

    If ExpressionCounter = 0 Then
        DSLookup = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)(0)
    Else
        ReDim retArr(ExpressionCounter)
        With DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)
            For i = 0 To ExpressionCounter
                retArr(i) = .Fields(i)
            Next i
        End With
        DSLookup = retArr
    End If
End Function

Die Parameter sollten selbsterklärend sein, sind die selben wie bei der Eingebauten DLookup() Funktion.
Der Rückgabewert ist jetzt vom Typ Variant, d.H. es können einzelne Werte als auch ganze Arrays zurückgegeben werden.

Der Beginn ist noch ziemlich einfach gehalten, es wird ein Abfragestring in der Variable strSQL gebildet, und je nach dem ob der optionale Parameter „Criteria“ angegeben wurde wird auch eine Where-Klausel angehängt mit diesem Parameter.
Je nach dem ob in Expression ein einzelnes Tabellenfeld oder eine Kommaliste an Tabellenfeldern steht wird danach unterschieden. ExpressionCounter ermittelt über die Split()-Funktion die Anzahl der Tabellenfelder.
Bei einem einzelnen Feld ist der Wert 0, und es wird die Methode OpenRecordset auf das Datenbankobjekt mit der entsprechenden Abfrage angewendet. Die (0) am Ende liefert genau den ersten gefundenen Eintrag. Fragt jetzt nicht warum ich DBEngine(0)(0) und nicht CurrentDB verwende, ersteres soll(te) bei bestimmten Datenbankabläufen schneller sein. Wer das genauer wissen möchte kann hier mal nachlesen: https://www.access-programmers.co.uk/../
Falls mehrere Tabellenfelder im Parameter „Expression“ stehen, wird zuerst das Rückgabe-Array Dimensioniert und in einer For/Next Schleife dieses mit Werten belegt.

Das wars auch schon.
Der Aufruf ist auch ziemlich simple wie nachfolgendes Beispiel zeigt:

Private Sub GetUsername()
    Dim Userdata As Variant
    Userdata = DSLookup("Vorname, Nachname", "dbo_User", "ID=21")
    MsgBox Userdata(0) & " " & Userdata(1)
End Sub

Aus der Tabelle dbo_User wird der Vorname und Nachname des Users mit ID 21 in das Array Userdata geschrieben und ausgegeben.

Alternativen und verschiedene Spielarten gibts natürlich auch noch. Z.B. könnte man ein leeres fertig Dimensioniertes Array ByRef an die Prozedur übergeben. Es wird dann aber vom Entwickler auch Selbstdisziplin verlangt – weil die Prozedur verlangt dann auch je nach Dimensionierung die korrekte Anzahl an Feldern im Recordsetobjekt. Aber wenn man bei klarem Kopf während des Entwickelns ist kann man sowas schon mal machen. Die Prozedur verkürzt sich dadurch stark auf fast die Hälfte:

Public Sub DSLookup(ByVal Expression As String, ByVal Domain As String, ByVal Criteria As String, ByRef retArr As Variant)
    Dim strSQL As String
    Dim i As Long

    strSQL = "SELECT " & Expression & " FROM " & Domain
    If Not Criteria = vbNullString Then strSQL = strSQL & " WHERE " & Criteria

    With DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)
        For i = 0 To UBound(retArr)
            retArr(i) = .Fields(i)
        Next i
    End With
End Sub

Der Aufruf ist jetzt ein klein wenig anderst, und zwar ist der Rückgabewert über das Array jetzt zwingend ein Array, und dieses muss auch dimensioniert sein zumindest der 0 für 1 Element. Und auch bei der Ausgabe/Weitergabe ist zu beachten dass auch nur bei einem einzelnen Tabellenfeld jetzt ein Array angesprochen werden muss mit dem ID 0.

Private Sub GetUsername()
    Dim Userdata(0) As Variant
    DSLookup "Vorname", "dbo_User", "ID=21", Userdata
    MsgBox Userdata(0)
End Sub

So, das wars jetzt aber erstmal für Heute, es wird sicherlich nicht weitere 4 Jahre dauern bis ihr was von mir hört.

Bis dahin
©2020 Andreas Vogt

Umgang mit globalen Variablen

By , 28. August 2015

Hallo,
heute möchte ich euch einen etwas anderen Umgang von globalen Variablen zeigen.
Wie diese definiert werden sollte bekannt sein, in einem Standardmodul erstellt man im Deklarationsbereich mittels dem Schlüsselword „Global“ oder „Public“ eine globale Variable die dann überall verwendet werden kann. Und genau dieser Vorteil ist auch der größte Nachteil. Diese Variablen können temporär von jeder Stelle aus überschrieben werden, auch durch die Deklaration von privaten Variablen gleichen Namens.
Das bedeutet, wenn Sie eine globale Variable haben, in z.B. einem Formularmodul eine private Variable gleichen Namens deklarieren, dann verwenden Sie innerhalb des Gültigkeitsbereichs der privaten Variable diese so als ob es keine globale Variable gleichen Namens gäbe. Sie können sich nicht mehr sicher sein welchen Inhalt die Variable z.Z. besitzt.

Gerade bei größeren Projekten erzeugen globale Variablen chaos, das Sie später kaum nachvollziehen können.
Das ist mir gestern erst selbst passiert bei einem VB.Net Projekt. Gewöhnt euch schon mal an den Gedanken globale Variablen nicht mehr zu verwenden!
Aber was ist die Alternative? Die Antwort ist so simple. Verwendet statt dessen globale Properties in einer Klasse.

Das funktioniert ziemlich simple:
Erstellt ein leeres Klassenmodul, benennt es z.B. „globVar“.
Dann erstellt ihr eure Properties, für jede globale Varialbe ein Get/Let Paar, bzw. bei Objektvariablen ein Get/Set-Paar, und jeweils dazu 1 private Membervariable.
Hier mal ein Beispiel:

Option Compare Database
Option Explicit
Private m_distance As Long
Private m_strsql AS String
Private m_frm AS Form

Public Property Get Distance() As Long
    Distance = m_distance 
End Property
Public Property Let Distance (ByVal value As Long)
    m_distance = value
End Property

Public Property Get strSQL() As Long
    strSQL = m_strsql 
End Property
Public Property Let strSQL(ByVal value As Long)
    m_strsql = value
End Property

Public Property Get FRM() As Form
    FRM = m_frm 
End Property
Public Property Set FRM(ByRef value As Form)
    m_frm = value
End Property

Verwendet wird es wie folgt:
In einem Modul wird das Klassenobjekt global deklariert:
Public globe As globVar
Dies sollte die einzige global deklarierte Variable sein, die du in deinem Projekt verwendest. In dem Codeteil der zuerst gestartet wird, z.B. das Form_Load() Ereignis eines Formulares, wir das Klassenobjekt gesetzt:
Set globe = New globVar

Jetzt können wir mit den Properties arbeiten wie mit Variablen:

Sub SetValues()
    With globe
        .Distance = 997
        .strSQL = "Select * From Tabelle1"
        Set .FRM = Form_Formular1
    End With
End Sub

Sub DataFormOpen()
    With globe
        .FRM.RecordSource = .strSQL
        DoCmd.OpenForm .FRM.Name
    End With
End Sub

Was zum Schluss noch fehlen würde, ist das löschen der Objektvariable beim Schließen des Programms, aber das ist nicht nötig da danach keine Variablen mehr existieren können.
ist doch ne coole Sache – oder? Kein Chaos mehr mit globalen Variablen!

Es macht zwar ein wenig mehr Aufwand, aber man kann sich das Leben etwas vereinfachen wenn man die MZ-Tools verwendet, einen Codeblock erstellt, und diesen dann per Tastenkombi einfach in den Code einfügt und den Variablennamen überschreibt. Aber probiert es einfach aus, der Aufwand wird sich lohnen und er wird zur Stabilität eurer Anwendung beitragen.

Bei sehr großen Projekten macht es übrigends Sinn für jeden Variablentyp eine eigene Klasse anzulegen, so behält man den Überblick wenn man einen Fehler sucht oder was ändern möchte.

Noch was zum Schluss: seit ihr in mehreren Entwicklungsumgebungen zuhause, dann könnt ihr das Prinzip meist direkt übertragen. Zumindest was VB6 angeht kann man per Copy+Paste das 1:1 übernehmen. In VB.Net sehen die Properties etwas anderst aus (besser!), aber das Prinzip ist das gleiche.

Bis dahin
©2015 Andreas Vogt

IBAN für deutsche Kontos berechnen

By , 24. Juli 2015

Hallo,
im letzten Beitrag gings um Modulo-Berechnung großer Zahlen. Und genau hier bei der Berechnung des IBAN benötigen wir diese Funktion.
Der übersicht wegen hab ich diese etwas gekürzt:

Private Function Modulo(ByVal Dividend As Double, ByVal Devisor As Double) As Long
    If Devisor = 0 Then Exit Function
    Modulo = Dividend - Fix(Dividend / Devisor) * Devisor
End Function

Bekannter Weise wird der IBAN wird gebildet aus:
– 2 Ziffern für die Länderkennung
– 2 Ziffern für die Prüfziffer
– Je nach Land bis zu 30 Ziffern für die Kontoidentifikation,
meist bestehend aus Bankleitzahl und Kontonummer und ggf. weiteren Kontrolziffern.

In Deutschland besteht die Kontoidentifikation aus 8-Stelliger Bankleitzahl und auf 10 Stellen aufgefüllt mit Nullen die Kontonummer.
Wie sich diese Kontoidentifikation zusammensetzt ist bei Wikipedia nachzulesen: https://de.wikipedia.org/wiki/IBAN

Kommen wir nun zum Berechnen der Prüfziffer, weil das das einzig schwierige am IBAN ist.
Diese wird Berechnet aus Bankleitzahl und Kontonummer durch Multiplikation von 62 mit den Modulo von BLZ durch 97 addiert mit 1 und dem Modulo von Kontonummer multipliziert mit 27 durch 97
Aus diesem ganzen Ausdruck wird wiederum der Modulo-Wert durch 97 ermittelt und von 98 abgezogen.

Also ziemlich verwirrend das ganze.
Deshalb teilen wir das auf in 2 Schritte, und speichern das Zwischenergebnis in einer Hilfsvariable:
Hilfsvar1 = 62 * (1 + Modulo(Blz, 97) + Modulo(27 * Kto, 97))

Die Prüfziffer berechnet sich dann wie folgt:
98 – Modulo(Hilfsvar1, 97)

Der Rest ist dann ziemlich einfach:

Public Function IBAN(ByVal Kto As Variant, ByVal Blz As Variant) As String
    Dim Hilfsvar1 As Variant
    
    Hilfsvar1 = 62 * (1 + Modulo(Blz, 97) + Modulo(27 * Kto, 97))
    IBAN = "DE" & 98 - Modulo(Hilfsvar1, 97)
    IBAN = IBAN & Blz & Left("0000000000", 10 - Len(Kto)) & Kto
End Function

Das wars auch schon wieder für heute.

Bis dahin
© 2015 Andreas Vogt

Modulo großer Zahlen berechnen

By , 23. Juli 2015

Hallo,
bei einer Berechnung von Modulo-Werten, also dem ganzzahligen Rest einer Division, bin ich auf ein Problem gestoßen, dessen Lösung ich euch nicht vorenthalten möchte.
Angenommen ihr möchtet den Modulo-Wert einer sehr großen Zahl berechnen. Dann stößt Access schnell an die Grenze des Longinteger-Wertebereichs, der bekanntlich bis 2147483647 reicht.
Beispiel:
2147483647 Mod 97 Ergebnis 65
2147483648 Mod 97 Ergebnis Überlauf.

Erinnert man sich wie der Modulo-Wert (ganzzahliger Rest einer Division) berechnet wird:
2147483648 geteilt durch 97 ergibt 22139006,86
Multipliziert man 22139006 mit 97, und zieht das Ergebnis von 2147483648 ab, so erhält man als Modulo-Wert 66

Und genau so bauen wir eine kleine Hilfsfunktion auf, die uns den Modulo-Wert berechnet:

Public Function Modulo(ByVal Dividend As Double, ByVal Devisor As Double) As Long
    Dim GanzzahlErgebnis As Long
    If Devisor = 0 Then Exit Function
    
    GanzzahlErgebnis = Fix(Dividend / Devisor)
    Modulo = Dividend - GanzzahlErgebnis * Devisor
End Function

Der Wert von GanzzahlErgebnis muss wirklich die abgeschnittene ganze Zahl der Division sein, deswegen muss hier die Funktion fix() verwendet werden.
Da wir immer den ganzzahligen Rest als Ergebnis möchten, genügt es die Prozedur als Long zu deklarieren.

Kopiert die Funktion in ein Modul und ruft sie z.B. wie folgt auf:

MsgBox Modulo(2200000000, 97)

Als Antwort wird die Zahl 36 ausgegeben.

Bis dahin
© 2015 Andreas Vogt

Big Numbers

By , 30. Juni 2015

Hallo,
heute möchte ich mal über richtig große Zahlen berichten, denn VBA hat genau mit denen Probleme diese zu verarbeiten.
Gerade in der Finanzwelt z.B. bei der Berechnung von Prüfziffern werden diese benötigt. Es sind dann schon spezielle Fälle, aber man sollte wissen wie man damit umgehen kann.

Schauen wir uns mal die Datentypen an, die uns in VBA zur Verfügung stehen:
– der Long-Datentyp ist bereits mit etwas über 2,1 Milliarden überfordert.
– Double schaft es immerhin auf 15 Stellen, bevor in die gerundete Exponential-Schreibweise gewechselt wird.
– eine weitere Möglichkeit ist der wenig bekannte Dezimal-Datentyp. Dieser lässt sich mit der Funktion CDec() herstellen, und damit haben wir schon 29 Stellen mit denen wir genau rechnen können.

Aber darüber hinaus? Nichts, Nada, Niente.

Angenommen Sie möchten von einer 36-Stelligen Zahl den Modulo nehmen, denn so groß kann maximal der BBAN (Basic Bank Account Number) nämlich werden: 30 Stellen Kontoidentifikation + 4 Stellen konvertiertes Länderkürzel + „00“

Mit dividieren so wie in den vorherigen Beitrag zum Modulo kommt man da nicht weit.

Aber es gibt für solche Fälle spezielle Rechenvorschriften, und eine möchte ich euch vorstellen, die Neun-Stellen-Regel.
Diese Regel besagt folgendes:

1. Von einer großen Zahl werden von links weg 9 Ziffern genommen werden, davon der Modulo genommen.
2. Es wird eine neue Zahl gebildet die mit dem berechneten Modulo beginnt, 
   und mit Ziffern der großen Zahl bis auf 9 Stellen aufgefüllt wird.
3. Von dieser neuen Zahl wird wieder der Modulo genommen
4. Die Vorgänge 2. und 3. werden so lange wiederholt, bis alle Ziffern der ursprünglichen 
   großen Zahl verarbeitet wurden.
5. Der Modulo, der bei der letzten Berechnung herauskommt, ist das Endergebnis.

Machen wir mal ein Beispiel.
Unsere große Zahl sei diese: 661400580’9000014’5786179’5321700’131400
Der Übersichtlichkeit ist diese in die verwendeten Blöcke eingeteilt.
Davon wollen wir den Modulo 97 bestimmen:

661400580 Mod 97 = 66
669000014 Mod 97 = 35
355786179 Mod 97 = 73
735321700 Mod 97 =  8
8131400   Mod 97 = 84

Der Modulo 97 userer großen Zahl ist also 84.

Um nun nicht ständig von Hand zu rechnen, erstellen wir aus diesen Informationen eine Prozedur.
Da wir von unserer großen Zahl (Dividend) nur Ziffern abschneiden, und nicht mit ihr rechnen, können wir diese als String-Parameter übergeben.

Public Function Modulo(ByVal Dividend As String, ByVal Devisor As Long)
    Dim NeueZahl As Long
    Dim ZwischenModulo As Variant

    Do While Len(Dividend) > 0
        NeueZahl = CLng(ZwischenModulo & Left(Dividend, 9 - Len(CStr(ZwischenModulo))))
        Dividend = Mid(Dividend, 10 - Len(CStr(ZwischenModulo)))
        ZwischenModulo = NeueZahl Mod Devisor
    Loop
    Modulo = ZwischenModulo
End Function

Was euch sicherlich Kopfzerbrechen macht ist diese Zeile:
NeueZahl = CLng(ZwischenModulo & Left(Dividend, 9 – Len(CStr(ZwischenModulo))))

Im ersten Durchlauf der Schleife ist ZwischenModulo (Typ Variant) Leer bzw. Empty. Daher ist Len(CStr(Zwischenmodulo)) = 0. Es werden also genau 9 Stellen von der großen Zahl genommen.
Im zweiten und weiteren Durchläufen ist ZwischenModulo mit dem zuvor berechneten Modulo besetzt. Die NeueZahl bildet sich also aus ZwischenModulo & 9-Len(CStr(ZwischenModulo)) Stellen der großen Zahl, um wieder maximal 9 Stellen zu erhalten.

Die Zeile: Dividend = Mid(Dividend, 10 – Len(CStr(ZwischenModulo))) schneidet einfach nur die verwendeten Ziffern von der großen Zahl ab.
Da die Mid()-Funktion 1-Basiert ist, muss man Mid(Dividend,10) schreiben um 9 Stellen vom Dividend abzuschneiden, also alles richtig.

Vieleicht noch der Hinweis warum ZwischenModulo als Variant deklariert ist und nicht als Long: Wäre er als Long deklariert dann wäre im ersten Schleifendurchgang der Wert nicht Leer sondern 0, und die Länge von CStr(0) ist nunmal 1 und nicht 0.

OK, ich denke ich konnte euch die Problematiken von richtig großen Zahlen – den Big Numbers – ein wenig näher bringen. Und die neue Modulo-Funktion könnt ihr auch sofort in euren Projekten einsetzen und ihr läuft nicht Gefahr dass irgendwann der Wertebereich nicht ausreicht oder dass falsche Ergebnisse durch die gerundete Exponential-Darstellung von Double auftreten, denn diese können in der Finanzwelt schnell sehr teuer werden.

Bis dahin
© 2015 Andreas Vogt

Median ermitteln

By , 16. Juni 2015

Hallo,
heute möchte ich euch zeigen wie man aus Werten einer Tabelle oder Abfrage den Median bestimmt. Laut Wikipedia ist die Definition für den Median einer Auflistung der Wert, der an der mittleren Stelle steht, wenn man die Werte der Größe nach sortiert.
Beispiel: 9;14;20;30;50 Der mittlere Wert der sortierten Auflistung ist hier die 20, also ist 20 der Median. Hat man eine gerade Anzahl an Werten, so gibt es keinen mittleren Wert, also nimmt man die beiden mittleren Werte der sortierten Auflistung und bildet daraus den Mittelwert. Beispiel: 9;14;20;30 Der Median berechnet sich hier aus (14 + 20) / 2, also 17.
Bildet man diese Vorschriften auf VBA Code ab, so ist zu unterscheiden zwischer gerader Anzahl Datensätze und ungerader. Dies lässt sich feststellen indem man durch 2 teilt und den ganzzahligen Rest sich ansieht. Das macht dankenswerter Weise die interne Methode Mod (Mod für Modulo) für uns.
Beispiele:
0 Mod 2 = 0
1 Mod 2 = 1
40 Mod 2 = 0
99 Mod 2 = 1
… usw.
Also überall wo 0 heraus kommt haben wir eine gerade Anzahl von Datensätzen. Aufpassen müssen wir bei der 0, also keine Datensätze. Wenn wir dies nicht beachten laufen wir in eine Fehlermeldung hinein.
So genug der Theorie, kommen wir man zum Code.

Public Function Median(ByVal TableName As String, ByVal FieldName As String) As Double
    Dim numDS As Long
    Dim lowerValue As Double
    Dim upperValue As Double
    Dim rst As DAO.Recordset

    Set rst = CurrentDb.OpenRecordset("Select " & FieldName & " From " & TableName & " Order By " & FieldName, dbOpenSnapshot)
    If Not rst.EOF Then
        With rst
            .MoveLast
            numDS = .RecordCount
            .MoveFirst
            If numDS Mod 2 = 0 Then
                .Move Int(numDS / 2) - 1
                lowerValue = .Fields(FieldName)
                .MoveNext
                upperValue = .Fields(FieldName)
                Median = (lowerValue + upperValue) / 2
            Else
                .Move Int(numDS / 2)
                Median = .Fields(FieldName)
            End If
        End With
        
        rst.Close: Set rst = Nothing
    Else
        rst.Close: Set rst = Nothing
        Err.Raise vbObjectError + 100, "Function Median", "Empty Recordset"
    End If
End Function

Der Funktion werden 2 Parameter übergeben, einen für den Tabellennamen bzw. den Namen der Abfrage, und einen für das Feldnamen von dem der Median berechnet werden soll.
Die Daten stellen wir in einem Recordset-Objekt zur Verfügung, worin diese auch gleich aufsteigend sortiert werden. Um die korrekte Anzahl von Datensätzen zu erhalten, muss der Datensatzzeiger ans Ende gesetzt werden.
Danach kommt die Entscheidung ob ganzzahlig oder nicht. Mal angenommen wir haben 27 Messwerte in der Tabelle. dann benötigen wir den 14. Wert. Also müssen wir den Datensatzzeiger um 13 Stellen von der ersten Position verschieben. Daher Int(numDS / 2) – 1. Bei 26 Messwerten benötigen wir den 13. und 14. Wert für die Mittelwertbildung. Das sind die Variablen lowerValue und upperValue. Also Datensatzzeiger um 26/2 -1 = 12 Datensätze verschieben. Beim upperValue brauchen wir einfach um 1 weiter gehen, daher Methode .MoveNext. Zu Schluss noch die üblichen Aufräumarbeiten die ja bei Recordsets bekannt sein sollten.

So jetzt noch der Fall dass das Recordset keine Datensätze liefern würde. Dann wird die äußere If-Verzweigung den Code übersprungen und zum Else-Teil wird ausgeführt. Dort schließen wir erstmal ordentlich das Recordset-Objekt und setzen es Nothing um das Objekt zu zerstören. Danach geben wir eine Fehlermeldung an die aufrufende Prozedur weiter die diese entsprechend verarbeiten kann.

Das wars auch schon, aufrufen kann man die Funktion aus einem Formular, Bericht, Modul oder auch Abfrage heraus.

Bis dahin
© 2015 Andreas Vogt

Umgang mit Optionswerten

By , 15. Mai 2015

Hallo,
heute befasse ich mich mit dem Thema „Umgang mit Optionswerten“. Es gibt kaum eine Anwendung die ohne Optionen auskommt. Sei es ein bestimmtes Verzeichnis oder bestimmte Werte oder Zustände.
Per Zufall bin ich heute auf eine Sache gestoßen in Verbindung mit Arrays: Ich wollte die in der gespeicherten Tabelle in ein Array laden um auf sie zugreifen zu können. Aber ein Element eines Arrays lässt sich nur über den Index abrufen, nicht über einen aussagekräftigen Namen.
Also hab ich mal herumgetüftelt, und schließlich doch eine sehr brauchbare Lösung gefunden.
Meine Tabelle hat 6 Optionsfelder. Ich erstelle also zuerst einen Öffentlichen Enum mit den Feldnamen:

Public Enum ltOption
    sportjahr = 0
    old_sportjahr = 1
    vereinsname = 2
    vereinsNummer = 3
    adminpassword = 4
    usestartgeld = 5
End Enum

Als nächstes benötigen wird 2 Variablen:

Public myOptions(5) As Variant
Private FieldNameArr As Variant

Zum Setzen der Optionswerte und zum Auslesen benötigen wird Get/Let Properties:

Public Property Get Settings(cOption As ltOption) As Variant
    Settings = myOptions(cOption)
End Property

Public Property Let Settings(cOption As ltOption, vValue As Variant)
    myOptions(cOption) = vValue
    CurrentDb.Execute "Update tabOptionen set " & FieldNameArr(cOption) & " = " & OptionDataType(vValue, cOption)
End Property

In der Get-Property wird als Optionswert die Nummer aus dem Enum übergeben. Daher kann man nun den entsprechenden Optionswert aus dem Array myOptions entnehmen.
In der Let-Property kommt jetzt eine Besonderheit zum Zuge, die ich vorher gar nicht kannte.
Definiert man eine Let-Property mit 2 Parametern, so kann man die Property wie folgt aufrufen:

PropertyName(ErsterParameter) = ZweiterParameter

Außerdem wird die Parameteränderung auch gleich in die Datenbank geschrieben damit sie permanent ist. Der Feldname erhalten wir aus dem Array FieldNameArr() mit dem Enum-Wert als Index.
Da wir hier an dieser Stelle nicht wissen, welcher Datentyp das Feld hat, muss man dies anhand des Enum-Wertes cOption überprüfen. Dies geschieht in einer kleinen Prozedur:

Private Function OptionDataType(vValue As Variant, cOption As Long) As Variant
    OptionDataType = vValue
    If cOption = 2 Or cOption = 4 Then
        OptionDataType = "'" & OptionDataType & "'"
    End If
End Function

D.H. Die Optionswerte 2 und 4, also die Felder vereinsname und adminpassword werden als Strings behandelt und in einfache Hochkommatas eingeschlossen.

Was noch fehlt ist die Initialisierung wo erstmals die Optionen ausgelesen und in das Array geschrieben werden. Dazu habe ich eine Public Sub Main() erstellt, die von einem Autoexec-Makro aufgerufen wird:

Public Sub Main()
    Dim i As Long
    FieldNameArr = Split("sportjahr,old_sportjahr,vereinsname,vereinsnummer,adminpassword,useStartgeld", ",")
    For i = 0 To 5
        myOptions(i) = DLookup(CStr(FieldNameArr (i)), "tabOptionen")
    Next i
    DoCmd.OpenForm "frmStart"
End Function

Im Array FieldNameArr stehen jetzt die tatsächlichen Feldnamen der Tabelle tabOptionen drin, wogegen man es oben beim Enum nicht so genau nehmen muss.
Anstelle der DLookup-Funktion kann man auch dessen Ersatzfunktionen verwenden die schneller arbeiten.

So unser Modul ist somit fertig und kann eingesetzt werden. Ich habe dazu mal ein Beispiel erstellt, das sich leicht nachbauen lässt. Man benötigt dazu:
1 Textfeld Text0, 3 CommandButtons cmdSet, cmdReset und cmdView.
Der Code sieht dann wie folgt aus:

Private Sub cmdReset_Click()
    Settings(sportjahr) = Settings(old_sportjahr)
End Sub

Private Sub cmdView_Click()
    Me.Text0 = Settings(sportjahr)
End Sub

Private Sub cmdSet_Click()
    Settings(old_sportjahr) = Settings(sportjahr)
    Settings(sportjahr) = 2017
End Sub

Private Sub Form_Load()
    Me.Text0 = Settings(sportjahr)
End Sub

Beim Formular laden wird das Sportjahr angezeigt. Bei cmdSet wird zuerst das aktuelle Sportjahr gesichert indem man dessen wert der Option old_sportjahr zuweist. danach wird das sportjahr mit 2017 überschrieben. Beim Reset wird nun der Wert aus old_sportjahr genommen und mit diesem der die Option sportjahr überschrieben.

Jetzt erahnt man auch warum das Enum im Modul als Public deklariert wurde, den wenn man jetzt schreibt „Settings(“ erscheinen die Werte aus dem Enum als Intellisense.
Um das speichern der Werte in der Tabelle kümmert sich auch das Modul, egal um was für ein Datentyp es sich handelt.
Probiert es aus, setzt Breakpoints um den Codeablauf zu verstehen, es ist ziemlich cool.

Bis dahin
©2015 Andreas Vogt

OfficeFolders theme by Themocracy