VBA-Funktionssammlung

In dieser Rubrik liefern wir Ihnen in jeder Ausgabe von Access im Unternehmen einige interessante VBA-Funktionen, mit denen Sie den Funktionsumfang von VBA erweitern können.

Montag und Sonntag ermitteln

Einige Anwendungsfälle benötigen das Datum eines Montags oder Sonntags für eine Kalenderwoche oder ein gegebenes Datum. Die beiden Routinen aus Listing 1 und Listing 2 erledigen Letzteres: Sowohl MontagErmitteln als auch SonntagErmitteln erwarten ein Datum als Parameter, zu dem die Routine dann den vorherigen Montag oder den folgenden Sonntag berechnet. Ein Einsatzfall ist etwa der Monatskalender in Berichtsform aus [1].

Listing 1: Montag einer Woche zu einem gegebenen Datum ermitteln

Public Function MontagErmitteln(dateReferenzdatum As Date) As Date
     Dim dateTemp As Date
     dateTemp = dateAusgangsdatum
     Select Case Weekday(dateTemp)
         Case Is > 2
             MontagErmitteln = _
DateAdd("d", dateTemp, -Weekday(dateTemp) + 2) Case 2 MontagErmitteln = dateTemp Case 1 MontagErmitteln = DateAdd("d", dateTemp, -6) End Select End Function

Listing 2: Sonntag einer Woche zu einem gegebenen Datum ermitteln

Public Function SonntagErmitteln(dateReferenzdatum As Date) As Date
     Dim dateTemp As Date
     dateTemp = dateAusgangsdatum
     Select Case Weekday(dateTemp)
         Case 1
             SonntagErmitteln = dateTemp
         Case Is > 1
             SonntagErmitteln = DateAdd("d", dateTemp, 8 - Weekday(dateTemp))
     End Select
End Function

Kalenderwoche ermitteln

Ebenfalls in [1] wird die Funktion Kalenderwoche benötigt, die zu einem Referenzdatum die passende Kalenderwoche ermittelt (s. Listing 3). Die Funktion setzt voraus, dass die erste Woche diejenige ist, die vier Tage des neuen Jahres enthält. Der übergabeparameter ist vom Typ Date, der Rückgabewert ist eine Integer-Zahl.

Listing 3: Kalenderwoche zu einem Datum ermitteln

Function Kalenderwoche(dateReferenzdatum As Date) _
As Integer Kalenderwoche = _
Format(dateReferenzdatum, "ww", vbMonday, _
vbFirstFourDays) If Kalenderwoche > 52 Then If Format(dateReferenzdatum + 7, _
"ww", vbMonday, vbFirstFourDays) = 2 Then Kalenderwoche = 1 End If End If End Function

Datum für SQL-Anweisung aufbereiten

Mit Datumswerten in SQL-Anweisungen gibt es immer wieder Probleme. Allerdings nicht, wenn Sie einen Ausdruck wie diesen hier verwenden:

Ende des frei verfügbaren Teil. Wenn Du mehr lesen möchtest, hole Dir ...

den kompletten Artikel im PDF-Format mit Beispieldatenbank

diesen und alle anderen Artikel mit dem Jahresabo

Schreibe einen Kommentar

VBA-Funktionssammlung

In dieser Rubrik liefern wir Ihnen in jeder Ausgabe von Access im Unternehmen einige interessante VBA-Funktionen, mit denen Sie den Funktionsumfang von VBA erweitern können.

Datei-öffnen-Dialog per WizHook

Mittlerweile gibt es eine ganze Reihe von Möglichkeiten, einen Dialog zum öffnen einer Datei anzuzeigen. Die allereinfachste Variante dürfte die per WizHook sein: Wichtig ist dabei nur, den richtigen WizHook-Key festzulegen; den Rest erledigt die Funktion OpenFileName (s. Listing 1). Ein Beispielaufruf lautet etwa:

OpenFileName CurrentProject.Path, "Dokument auswählen", "Bilddateien (*.tif,*.gif,*.jpg,*.png,*.bmp)"

Der resultierende Dialog sieht wie in Bild 1 aus. Für eine Mehrfachauswahl verwenden Sie statt des Werts &h40 den Wert &h48. Weitere Informationen zum Dateiauswahl-Dialog der WizHook-Klasse finden Sie im Beitrag WizHook – versteckte Features in Access (s. Shortlink 358) – dort erfahren Sie etwa, wie Sie verschiedene Ansichten einstellen (Detailansicht, Vorschau, Symbole) oder wie Sie die Funktion für die Anzeige eines Verzeichnisauswahl-Dialogs zweckentfremden.

pic001.tif

Bild 1: Ein per WizHook geöffneter Dateiauswahl-Dialog

Listing 1: Datei-öffnen-Dialog per WizHook

Function OpenFileName(Optional StartDir As String, _
     Optional sTitle As String = "Datei auswählen:", _
     Optional sFilter As String = _
"Access-DB (*.mdb)|Alle Dateien (*.*)") As String Static sDir As String WizHook.Key = 51488399 If Len(StartDir) = 0 Then If Len(sDir) = 0 Then StartDir = CurrentProject.Path Else StartDir = sDir End If End If Call WizHook.GetFileName(Application.hWndAccessApp, _ "Microsoft Access", sTitle, _ "öffnen", OpenFileName, _ StartDir, sFilter, _ 0&, 0&, &H40, False) If Len(OpenFileName) > 0 Then sDir = Left(OpenFileName, InStrRev(OpenFileName, "\", _
, vbTextCompare)) End If End Function

Datei mit der richtigen Anwendung öffnen

Wenn Sie etwa per Dateidialog, per direkter Eingabe durch den Benutzer oder aus einer anderen Quelle wie einem Tabellenfeld den Namen einer Datei ermittelt haben, die es nun zu öffnen gilt, brauchen Sie dazu eine passende Funktion. In diesem Fall hilft API weiter: Die API-Funktion ShellExecute ist die Grundlage für die Funktion OpenDocument (s. Listing 2). Der einzige Parameter dieser Wrapper-Funktion ist der Name der zu öffnenden Datei. Voraussetzung für die Funktion ist die Deklaration der API-Funktion ShellExecute in einem Standardmodul.

Listing 2: Datei mit der passenden Anwendung öffnen

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Public Function OpenDocument(DocumentFile As String) As Long Dim ret As Long If Len(DocumentFile) > 0 Then ret = ShellExecute(Application.hWndAccessApp, _
"open", DocumentFile, vbNullChar, "", 1) If Err Then OpenDocument = 0 ElseIf ret > 32 Then OpenDocument = -1 Else OpenDocument = ret End If Else OpenDocument = 0 End If End Function

Dateiendung ermitteln

Die Funktion DateiendungErmitteln erwartet die Angabe eines Dateinamens als Parameter, ermittelt den letzten Punkt in dieser Zeichenkette und gibt alles zurück, was sich dahinter befindet (s. Listing 3). Hilfreich ist dabei die Funktion InStrRev, die das erste Vorkommen einer Zeichenkette von hinten ermöglicht. Benutzer von Access 97 und älter müssen selbst eine benutzerdefinierte Funktion gleichen Namens bereitstellen, da die passende VBA-Version diese Funktion noch nicht enthält. Diese könnte wie die im nächsten Abschnitt vorgestellte Funktion aussehen.

Listing 3: Dateiendung ermitteln

Public Function DateiendungErmitteln(strDateiname As String) As String
     DateiendungErmitteln = Mid(strDateiname, InStrRev(strDateiname, ".") + 1)
End Function

InStrRev97 – InStrRev für Access 97

Wer noch nicht mit Access 97 arbeitet (Hinweis: Diese Version ist nun fast zehn Jahre alt …), vermisst möglicherweise die Funktion InStrRev. Diese lässt sich relativ einfach nachbauen – aufbauend auf der Funktion InStr und einer zusätzlichen Do Loop-Schleife (s. Listing 4). Die Funktion sucht so lange nach Vorkommen des übergebenen Suchbegriffs, bis keiner mehr gefunden wird – der letzte Fundort schließlich ist der, den InStrRev zurückgeliefert hätte. Ist einfach, aber viel mehr Einsatzzwecke als das Ermitteln von Dateiendungen scheint es nicht zu geben.

Listing 4: InStrRev für Benutzer von Access 97

Public Function InStrRev97(strCheck As String, strMatch As String, _
Optional lngStart As Long, Optional lngCompare As VbCompareMethod) Dim intPosStart As Integer Dim intPosTemp As Integer intPosStart = InStr(1, strCheck, strMatch, lngCompare) Do While Not intPosStart = 0 intPosTemp = intPosStart intPosStart = InStr(intPosStart + Len(strMatch), strCheck, _
strMatch, lngCompare) Loop InStrRev97 = intPosTemp End Function

Anführungszeichen
verdoppeln

Die Verarbeitung von Benutzereingaben oder Datenimporten scheitert oft daran, dass in den eingegebenen Daten Anführungszeichen oder Hochkommata enthalten sind. Wenn Sie etwa in einem Textfeld einen Suchbegriff abfragen, der als Kriterium für eine SQL-Anweisung verwendet werden soll, verarbeiten Sie diese üblicherweise wie folgt (in einer Zeile):

strSQL = 
"SELECT * FROM tblKontakte WHERE Vorname LIKE "" & strSuchbegriff & "'"

Gibt der Benutzer nun eine Zeichenkette wie Horst’s Heimtierbedarf ein, die ein Hochkomma enthält, sieht die Anweisung mit eingefügtem Suchbegriff so aus:

strSQL = "SELECT * FROM tblKontakte WHERE Vorname LIKE "Horst''s Heimtierbedarf'"

Access erfasst das Hochkomma in Horst’s nun als schließendes Element einer Zeichenkette und muss den Rest als Fehler interpretieren. Wenn Sie hingegen dafür sorgen, dass alle im Suchbegriff enthaltenen Hochkommata vor dem Einfügen in den SQL-Ausdruck verdoppelt werden, interpretiert Access den Ausdruck richtig. Dazu verwenden Sie die Funktion aus Listing 5.

Listing 5: Anführungszeichen und Hochkommata in einer Zeichenkette verdoppeln

Public Function AnfuehrungszeichenVerdoppeln(strText As String) As String
     AnfuehrungszeichenVerdoppeln = _
Replace(Replace(strText, """", """"""), "'", "''") End Function

Monatsbeginn ermitteln

Den ersten Tages eines Monats kann man mit DateSerial ermitteln. Dabei setzten Sie das Datum einfach aus dem Jahr und dem Monat des angegebenen Datums sowie dem Wert 1 für den Tag-Parameter ein (s. Listing 6).

Listing 6: Ermitteln des ersten Tages eines Monats

Ende des frei verfügbaren Teil. Wenn Du mehr lesen möchtest, hole Dir ...

den kompletten Artikel im PDF-Format mit Beispieldatenbank

diesen und alle anderen Artikel mit dem Jahresabo

Schreibe einen Kommentar