Zur Hauptseite ... Zum Onlinearchiv ... Zum Abonnement ... Zum Newsletter ... Zu den Tools ... Zum Impressum ... Zum Login ...

Achtung: Dies ist nicht der vollständige Artikel, sondern nur ein paar Seiten davon. Wenn Sie hier nicht erfahren, was Sie wissen möchten, finden Sie am Ende Informationen darüber, wie Sie den ganzen Artikel lesen können.

Kompletten Artikel lesen?

Einfach für den Newsletter anmelden, dann lesen Sie schon in einer Minute den kompletten Artikel und erhalten die Beispieldatenbanken.

E-Mail:

Gedrucktes Heft

Diesen Beitrag finden Sie in Ausgabe 2/2002.

Diesen Artikel jetzt als PDF plus Beispieldatenbank herunterladen?

Wenn Sie sich jetzt für den Newsletter anmelden, erhalten Sie in Kürze eine E-Mail mit dem Artikel im PDF-Format plus Beispieldatenbank.

Hier anmelden:973517

E-Mail:

Anrede:

Vorname:

Nachname:

Tipps und Tricks zu VBA

Autor: Christoph Spielmann, Düsseldorf

Auf den folgenden Seiten versorgen wir Sie mit einigen Tipps und Tricks rund um VBA, die Sie sofort in Betrieb nehmen können. Hier finden Sie beispielsweise eine Möglichkeit, Zeichenketten innerhalb von Zeichenketten zu deklarieren, und lernen, die Dateiendung einer Datei zu ermitteln. Wenn Sie schon einmal mit dem Vergleich von Datumswerten zu kämpfen hatten, finden Sie hier ebenfalls eine Lösung. Diese und weitere nachfolgend beschriebene Tipps und Tricks für alltäglich auftretende Probleme legen Sie am besten griffbereit in Reichweite des PCs - Sie werden sie gut gebrauchen können.

Zeichenketten in
Zeichenketten in
Zeichenketten

Die Verwendung des doppelten Anführungszeichens " (Ascii-Zeichencode 34) im Code bereitet ein paar kleine Schwierigkeiten. String-Literale (Klartext-Strings) müssen selbst bereits in Anführungszeichen eingeschlossen werden.

Public Function AddQuotes(Text As String, Optional _
  ByVal AddQuotesMode As AddQuotesModeConstants) _
  As String

  Dim nLeftQuotes, nRightQuotes, nQuotes As Long

  Select Case AddQuotesMode

    Case aqForce: AddQuotes = vbQuote & Text & vbQuote

    Case aqToPairs

      nLeftQuotes = zGetLeftQuotes(Text)

      nRightQuotes = zGetRightQuotes(Text)

      If nLeftQuotes Or nRightQuotes Then

        nQuotes = nLeftQuotes - nRightQuotes

        Select Case Sgn(nQuotes)

          Case -1: AddQuotes = _
            String(Abs(nQuotes), 34) & Text

          Case 0: AddQuotes = Text

          Case 1: AddQuotes = Text & String(nQuotes, 34)

        End Select

Daher kann das Anführungszeichen nicht so einfach innerhalb eines String-Literals verwendet werden. Es ist zu verdoppeln:

Text = "Hallo ""Welt""!"

Wenn Sie ein einzelnes Anführungszeichen einer Variablen zuweisen oder es als Parameter übergeben wollen, sieht das in dieser Schreibweise etwas verwirrend aus:

Anführungszeichen = """"

Sie können natürlich in solchen Fällen auch die Chr$-Funktion verwenden, um das Anführungszeichen anhand des Ascii-Codes zu erhalten, wie folgendes Beispiel zeigt:

Anführungszeichen = Chr$(34)

      Else

        AddQuotes = vbQuote & Text & vbQuote

      End If

    Case aqEnsureSinglePair

      nLeftQuotes = zGetLeftQuotes(Text)

      nRightQuotes = zGetRightQuotes(Text)

      Select Case nLeftQuotes

        Case 0:

          Select Case nRightQuotes

            Case 0: AddQuotes = vbQuote & Text & vbQuote

            Case 1: AddQuotes = vbQuote & Text

            Case Else: AddQuotes = vbQuote & _
              Left$(Text, Len(Text) - nRightQuotes + 1)

          End Select

        Case 1

          Select Case nRightQuotes:

            Case 0: AddQuotes = Text & vbQuote

            Case 1: AddQuotes = Text

            Case Else: AddQuotes = _
              Left$(Text, Len(Text) - nRightQuotes + 1)

          End Select

      Case Else

        Select Case nRightQuotes

          Case 0: AddQuotes = _
            Mid$(Text, nLeftQuotes) & vbQuote

          Case 1: AddQuotes = Mid$(Text, nLeftQuotes)

          Case Else: AddQuotes = Mid$(Text, _
            nLeftQuotes, Len(Text) - nRightQuotes)

        End Select

      End Select

  End Select

End Function

Public Function StripQuotes(Text As String, _

  Optional ByVal StripQuotesMode As _
  StripQuotesModeConstants) As String

  Dim nLeftQuotes, nRightQuotes, nQuotes As Long

  Select Case StripQuotesMode

    Case sqAll

      nLeftQuotes = zGetLeftQuotes(Text)

      nRightQuotes = zGetRightQuotes(Text)

      StripQuotes = Mid$(Text, nLeftQuotes + 1, _
        Len(Text) - nLeftQuotes - nRightQuotes)

    Case sqAllPairs

      nLeftQuotes = zGetLeftQuotes(Text)

      nRightQuotes = zGetRightQuotes(Text)

Quellcode 2 (Teil 1)

Diese Schreibweise ist jedoch eher umständlich. Eine Konstante im üblichen Stil der Visual Basic-Konstanten ist erheblich einfacher und auch leichter lesbar.

Allerdings können Sie Konstanten nicht per Funktion erzeugen - folgende Konstanten-Deklaration würde vom Kompiler nicht akzeptiert:

Public Const vbQuote = _
    Chr$(34)

Wenn Sie eine Anführungszeichenkonstante wie folgt in einem Standardmodul deklarieren, benötigen Sie die verwirrende Schreibweise mit den vier aufeinanderfolgenden Anführungszeichen nur ein einziges Mal:

Public Const vbQuote = _
    """"

Da Anführungszeichen zumeist paarweise verwendet werden, ist es recht praktisch, das Hinzufügen oder Entfernen von Anführungszeichen-Paaren in Hilfsfunktionen zu packen.

Die Funktion AddQuotes (s. Quellcode 1) fügt Anführungszeichen zu einem gegebenen String hinzu.

Im optionalen Parameter AddQuotesMode können Sie festlegen, ob ein Anführungszeichen-Paar in jedem Fall hinzugefügt werden soll (aqForce, Voreinstellung) oder ob eine ungleiche Anzahl von Anführungszeichen am Anfang und am Ende des betreffenden Strings zu Paaren aufgefüllt werden soll (aqToPairs).

      Select Case nLeftQuotes

        Case Is >= nRightQuotes

          nQuotes = nRightQuotes

        Case Else

          nQuotes = nLeftQuotes

      End Select

      StripQuotes = Mid$(Text, nQuotes + 1, _
        Len(Text) - 2 * nQuotes)

    Case sqSinglePair

      If Left$(Text, 1) = vbQuote And _
        Right$(Text, 1) = vbQuote Then

        StripQuotes = Mid$(Text, 2, Len(Text) - 2)

      End If

  End Select

End Function

Quellcode 2 (Teil 2)

Private Function zGetLeftQuotes(Text As String) As Long

  Dim nLeftQuotes, nPos, nStart As Long

  nStart = 1

  Do

    nPos = InStr(nStart, Text, vbQuote)

    If nPos = nStart Then

      nLeftQuotes = nLeftQuotes + 1

      nStart = nStart + 1

    Else

      zGetLeftQuotes = nLeftQuotes

      Exit Function

    End If

  Loop

End Function

Quellcode 3

Private Function zGetRightQuotes(Text As String) As Long

  Dim nRightQuotes, nPos, nStart As Long

  nStart = Len(Text)

  Do

    nPos = InStrRev(Text, vbQuote, nStart)

    If nPos = nStart Then

      nRightQuotes = nRightQuotes + 1

      nStart = nStart - 1

    Else

      zGetRightQuotes = nRightQuotes

      Exit Function

    End If

  Loop

End Function

Quellcode 4

Den dritten Parameter verwenden Sie, wenn sichergestellt werden soll, dass der im String enthaltene Text von genau einem Anführungszeichen-Paar eingeschlossen wird.

Dazu legen Sie zunächst einmal die möglichen Parameter fest, mit denen der Benutzer die Funktion aufrufen kann:

Public Enum _
AddQuotesModeConstants

aqForce

aqToPairs

aqEnsureSinglePair

End Enum

Die Hilfs-Funktion StripQuotes (s. Quellcode 2) bietet Ihnen ebenfalls mehrere Möglichkeiten. Hier geben Sie im optionalen Parameter StripQuotesMode an, ob alle einschließenden Anführungszeichen entfernt werden sollen, ob alle Paare entfernt werden sollen oder ob genau ein Paar entfernt werden soll.

Auch für den Betrieb dieser Funktion definieren Sie zunächst einen Satz von Konstanten, die als Parameter neben dem zu bearbeitenden String übergeben werden sollen:

Public Enum _
  StripQuotesModeConstants

  sqAll

  sqAllPairs

  sqSinglePair

End Enum

Beide Funktionen ermitteln in den meisten Fällen erst einmal die vorhandene Anzahl der links- und rechtsseitigen Anführungszeichen über die privaten Hilfs-Funktionen zGetLeftQuotes (s. Quellcode 3) und zGetRightQuotes (s. Quellcode 4). Dies reduziert deutlich die Anzahl der anfallenden einzelnen String-Operationen, die relativ langsam wären.

Private Function GetFileExtension(Path As String) _
    As String

    Dim nPosDot As Long

    nPosDot = InStrRev(Path, ".")

    If nPosDot Then

        If InStrRev(Path, "\") < nPosDot Then

            GetFileExtension = Mid$(Path, nPosDot + 1)

        End If

    End If

End Function

Quellcode 5

Private Function GetFileExtension5(Path As String) _

    As String

    Dim I, nPosDot, nPosBS, nStart As Integer

    Do

        nPosDot = InStr(nStart + 1, Path, ".")

        If nPosDot Then

            nStart = nPosDot

        Else

            nPosDot = nStart

            Exit Do

        End If

    Loop

    nStart = 0

    Do

        nPosBS = InStr(nStart + 1, Path, "\")

        If nPosBS Then

            nStart = nPosBS

        Else

            nPosBS = nStart

            Exit Do

        End If

    Loop

    If nPosDot Then

        If nPosBS < nPosDot Then

            GetFileExtension5 = Mid$(Path, nPosDot + 1)

        End If

    End If

End Function

Quellcode 6

Ende ohne Schrecken

Das Extrahieren der Dateierweiterung (Extension) einer Datei sollte an sich recht einfach sein: Sie beginnt hinter dem letzten Punkt im Dateinamen. Enthält der Dateiname keinen Punkt, hat die Datei auch keine Erweiterung. Solange es sich um einen Dateinamen ohne Pfadteile handelt, können Sie diesen letzten Punkt problemlos vom Ende einer Datei her ausfindig machen und aus dem Antreffen eines Punkts auf das Vorhandensein einer Dateierweiterung schließen.

Sobald Sie es jedoch mit einem ganzen Pfad zu tun haben, funktioniert dies nicht mehr zuverlässig. Denn falls einer der übergeordneten Pfadbestandteile selbst eine Erweiterung hat und die Datei am Ende bzw. der letzte Pfad nicht erweitert ist, würde so der gesamte Teil ab dem gefundenen letzten Punkt als Dateierweiterung betrachtet, bestehend aus der Erweiterung dieses Pfadbestandteils und aus allen nachfolgenden Pfadbestandteilen. Zum Beispiel ergäbe der Pfad:

c:\abc.def\ghi\jkl

als Dateierweiterung:

def\ghi\jkl

Zu einem korrekten Ergebnis gelangen Sie, wenn Sie zunächst sowohl die Position des letzten Punktes als auch die des letzten Backslashs ermitteln. Dann prüfen Sie, falls überhaupt ein Punkt gefunden wurde, ob die Position des letzten Backslash kleiner als die des letzten Punktes ist - nur dann markiert der Punkt den Beginn der Dateierweiterung des letzten Pfadbestandteils.

Public Function IsSameMonth (ByVal Date1 As Date, _
    ByVal Date2 As Date) As Boolean

    IsSameMonth = Not CBool(DateDiff("m", Date1, Date2))

End Function

Quellcode 7

Public Function IsSameQuarter (ByVal Date1 As Date, _
    ByVal Date2 As Date) As Boolean

    IsSameQuarter = _
        Not CBool(DateDiff("q", Date1, Date2))

End Function

Public Function IsSameWeek (ByVal Date1 As Date, _
    ByVal Date2 As Date) As Boolean

    IsSameWeek = Not CBool(DateDiff("w", Date1, Date2))

End Function

Public Function IsSameDay (ByVal Date1 As Date, _
    ByVal Date2 As Date) As Boolean

    IsSameDay = Not CBool(DateDiff("d", Date1, Date2))

End Function

Public Function IsSameHour (ByVal Date1 As Date, _
    ByVal Date2 As Date) As Boolean

    IsSameHour = Not CBool(DateDiff("h", Date1, Date2))

End Function

Public Function IsSameMinute (ByVal Date1 As Date, _
    ByVal Date2 As Date) As Boolean

    IsSameMinute = Not CBool(DateDiff("n", Date1, _
        Date2))

End Function

Public Function IsSameSecond (ByVal Date1 As Date, _
    ByVal Date2 As Date) As Boolean

    IsSameSecond = Not CBool(DateDiff("s", Date1, _
        Date2))

End Function

Quellcode 8

Ab VBA6 (Access 2000) können Sie zur Ermittlung der jeweils letzten Positionen die Funktion InStrRev verwenden, wie die Funktion aus Quellcode 5 zeigt.

In früheren VBA-Versionen steht die Funktion InStrRev noch nicht zur Verfügung - Sie können stattdessen eine eigene Implementierung der Erweiterungssuche mit einer schnellen, von vorne beginnenden Suche auf der Basis der InStr-Funktion verwenden. Sie finden diese Funktion in Quellcode 6.

Gleich oder nicht gleich?

Ob es sich bei zwei Datumsangaben um den gleichen Monat handelt, scheint auf den ersten Blick klar zu sein:

If Month(Date1) = _
    Month(Date2) Then...

Doch sollten die Datumsangaben aus verschiedenen Jahren sein, ist dieser Vergleich sicher nicht zutreffend.

Nun könnten Sie zwar auch noch das Jahr prüfen, aber es geht einfacher: Mit der VBA-Funktion DateDiff ermitteln Sie stattdessen die tatsächliche Differenz zwischen den Monaten (s. Quellcode 7).

Nur wenn die Differenz gleich 0 ist, handelt es sich um exakt denselben Monat.

Nach dem gleichen Prinzip können Sie auch alle anderen Datumsbestandteile direkt vergleichen - Quartale, Wochen, Tage, Stunden, Minuten und sogar Sekunden (s. Quellcode 8).

Punkt, Punkt, Komma, Strich - fertig ist der Ärger!

Dass das Datumstrennzeichen ein Punkt und das Dezimal-Trennzeichen ein Komma ist, ist in Deutschland selbstverständlich.

Doch ärgern Sie sich bestimmt auch immer wieder über Software aus anderen Ländern, die jeweils von den dortigen Gepflogenheiten ausgeht, ohne unsere Ländereinstellungen zu berücksichtigen.

Damit man sich in anderen Ländern nicht genauso über Ihre Software-Produkte ärgert, sollten Sie dafür sorgen, dass diese in internationaler Hinsicht fit sind.

Private Declare Function GetLocaleInfo Lib "kernel32" _

    Alias "GetLocaleInfoA" (ByVal Locale As Long, _
    ByVal LCType As Long, ByVal lpLCData As String, _
    ByVal cchData As Long) As Long

Private Declare Function GetUserDefaultLCID _
    Lib "kernel32" () As Long

Public Enum LocaleStringConstants

  locCurrency = &H14

  locCurSymbol = &H15

  locDate = &H1D

  locDecimal = &HE

  locList = &HC

  locMoneyDecimal = &H16

  locMoneyThousands = &H17

  locNegative = &H51

  locPositive = &H50

  locThousands = &HF

  locTime = &H1E

End Enum

Quellcode 9

Public Property Get LocaleString(Info As _
    LocaleStringConstants) As String

    Dim nLocale As String

    Dim nLen As Long

    nLocale = Space$(10)

    nLen = GetLocaleInfo(GetUserDefaultLCID(), Info, _
        nLocale, 10)

    LocaleString = Left$(nLocale, nLen - 1)

End Property

Quellcode 10

Zur lokal korrekten Darstellung von Zahlen und Datumswerten verhelfen Ihnen die vielen Möglichkeiten der Format-Funktion.

Doch wenn Sie den Währungsbezeichner oder eines der Trennzeichen einmal solo benötigen sollten, hilft Ihnen die Format-Funktion nur wenig weiter. So könnten Sie das Dezimal-Trennzeichen mit der Format-Funktion etwa auf folgende Weise ermitteln:

DecimalSeparator = _
    Mid$(Format$(1.1, _
    "0.0"), 2, 1)

Aber das ist nicht sonderlich elegant - und spätestens beim Währungsbezeichner sind Sie damit am Ende. Und außerdem kommen Sie nicht an solche Feinheiten heran, die Windows durchaus auch kennt, nämlich an möglicherweise unterschiedliche Dezimal-Trenn-zeichen für "normale" Zahlen und für Währungsbeträge.

Die korrekten Zeichen und Strings können Sie mit der API-Funktion GetLocaleInfo ermitteln (s. Quellcode 9).

Die wichtigsten davon liefert Ihnen die Hilfsfunktion LocaleString (s. Quellcode 10, als Eigenschaft in einem Standard-Modul implementiert), die den etwas umständlichen Aufruf von GetLocaleInfo enthält und automatisch auf die lokalen Einstellungen des aktuellen Users zurückgreift (GetUserDefaultLCID).

Public Function GetDecimals(ByVal Number As Double) _
    As Double

    GetDecimals = Number - Fix(Number)

End Function

Public Function GetDecimalsS(ByVal Number As Single) _
    As Single

    GetDecimalsS = Number - Fix(Number)

End Function

Public Function GetDecimalsC(ByVal Number As Currency) _
    As Currency

    GetDecimalsC = Number - Fix(Number)

End Function

Quellcode 11

Public Function PathPlusBS(Path As String) As String

    Select Case Right$(Path, 1)

        Case "\"

            PathPlusBS = Path

        Case Else

            PathPlusBS = Path & "\"

    End Select

End Function

Public Function PathNoBS(Path As String) As String

    Select Case Right$(Path, 1)

        Case "\"

            PathNoBS = Left$(Path, Len(Path) - 1)

        Case Else

            PathNoBS = Path

    End Select

End Function

Quellcode 12

Nachzügler getrennt

Da es keine Funktion gibt, die den Nachkomma-Anteil einer Zahl zurückgibt, können Sie diesen auf einem kleinen Umweg erhalten. Sie subtrahieren einfach den ganzzahligen Anteil von der Zahl.

Den ganzzahligen Anteil erhalten Sie über die relativ unbekannte VBA-Funktion Fix. Die Funktion Fix schneidet tatsächlich nur den Nachkomma-Anteil ab, im Gegensatz zu Funktionen wie Int, CInt oder CLng, die statt dessen automatisch runden:

Decimals = Number - Fix(Number)

Oder Sie verwenden die praktischen datentypspezifischen Hilfsfunktionen (Double als Standard-Ausführung), die Sie in Quellcode 11 finden.

Der Pfad zur Glückseligkeit

Je nach dem, wozu Sie eine Pfadangabe benötigen, muss sie mit einem Backslash abgeschlossen werden oder nicht. Wenn Sie etwa einen Dateinamen anhängen möchten, ist es praktisch, von vornherein sicherzustellen, dass der Pfad bereits mit dem zur Trennung notwenigen Backslash endet.

Statt jedes Mal den gleichen Code einzugeben, genügt allerdings ein Funktionsaufruf: PathPlusBS (s. Quellcode 12) ergänzt einen übergebenen Pfadnamen mit einem Backslash, falls dieser fehlen sollte, und PathNoBS macht das Gegenteil - entfernt den störenden Backslash, falls dieser vorhanden ist.

Public Function PathPlusS(Path As String) As String

    Select Case Right$(Path, 1)

        Case "/"

            PathPlusS = Path

        Case Else

            PathPlusS = Path & "/"

    End Select

End Function

Quellcode 13

Public Function PathNoS(Path As String) As String

    Select Case Right$(Path, 1)

        Case "/"

            PathNoS = Left$(Path, Len(Path) - 1)

        Case Else

            PathNoS = Path

    End Select

End Function

Quellcode 14

Public Function RndNum(ByVal LBnd As Long, _
    ByVal UBnd As Long, _

    Optional ByVal DoRandomize As Boolean) As Long

    If DoRandomize Then

        Randomize Timer

    End If

    RndNum = Int((UBnd - LBnd + 1) * Rnd + LBnd)

End Function

Quellcode 15

Eine Prüfung, ob der Pfad tatsächlich existiert, wird nicht vorgenommen - das müssen Sie gegebenenfalls selbst erledigen.

Sie haben das Ende des frei verfügbaren Teils des Artikels erreicht. Lesen Sie weiter, um zu erfahren, wie Sie den vollständigen Artikel lesen und auf viele hundert weitere Artikel zugreifen können.

Sind Sie Abonnent?Jetzt einloggen ...
 

Kompletten Artikel lesen?

Einfach für den Newsletter anmelden, dann lesen Sie schon in einer Minute den kompletten Artikel und erhalten die Beispieldatenbanken.

E-Mail:

Diesen Artikel jetzt als PDF plus Beispieldatenbank herunterladen?

Wenn Sie sich jetzt für den Newsletter anmelden, erhalten Sie in Kürze eine E-Mail mit dem Artikel im PDF-Format plus Beispieldatenbank.

Hier anmelden:

E-Mail:

Anrede:

Vorname:

Nachname:

© 2003-2015 André Minhorst Alle Rechte vorbehalten.