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

Sie haben das Ende des frei verfügbaren Textes erreicht. Möchten Sie ...

TestzugangOder bist Du bereits Abonnent? Dann logge Dich gleich hier ein. Die Zugangsdaten findest Du entweder in der aktuellen Print-Ausgabe auf Seite U2 oder beim Online-Abo in der E-Mail, die Du als Abonnent regelmäßig erhältst:

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

Sie haben das Ende des frei verfügbaren Textes erreicht. Möchten Sie ...

TestzugangOder bist Du bereits Abonnent? Dann logge Dich gleich hier ein. Die Zugangsdaten findest Du entweder in der aktuellen Print-Ausgabe auf Seite U2 oder beim Online-Abo in der E-Mail, die Du als Abonnent regelmäßig erhältst:

Schreibe einen Kommentar