Tipps und Tricks 6/2001

Autor: Christoph Spielmann, Düsseldorf

Auf den folgenden Seiten versorgt Sie unser Autor Christoph Spielmann mit einigen Tipps und Tricks rund um VBA, die Sie sofort in Betrieb nehmen können. Hier finden Sie beispielsweise eine Möglichkeit, die Bildschirmauflösung zu ermitteln, was z. B. für die Auslegung der Größe von Formularen sehr interessant sein kann. Sie lernen, wie Sie Dateien richtig löschen (ohne doppelten Boden, direkt in den Reißwolf) und wie Sie dem Anwender von Ihrer Applikation aus eine Möglichkeit zur Verfügung stellen, mal eben eine Diskette zu formatieren. Falls Sie einmal ein bestimmtes Systemverzeichnis auf Ihrer Festplatte vermissen – keine Sorge, hier finden Sie die richtige Funktion, um es wiederzufinden. Die nachfolgend beschrieben packen Sie am besten gut an eine sichere Stelle – Sie werden sie immer wieder benötigen.

Einige Office-Anwendungen stellen Ihnen die aktuelle Bildschirmgröße direkt zur Verfügung. So finden Sie beispielsweise in den Eigenschaften HorizontalResolution und VerticalResolution des System-Objekts der Word-Bibliothek die Breite und die Höhe des Bildschirms in Pixel:

Breite = System.HorizontalResolution
Höhe = System.VerticalResolution
Private Declare Function GetDC Lib "user32" _
    (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
    (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
    (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Const HORZRES = 8
Private Const VERTRES = 10
Public Property Get ScreenHeightPixels() As Long
    Dim nDC As Long
    nDC = GetDC(0)
    ScreenHeightPixels = GetDeviceCaps(nDC, VERTRES)
    ReleaseDC 0, nDC
End Property
Public Property Get ScreenWidthPixels() As Long
    Dim nDC As Long
    nDC = GetDC(0)
    ScreenWidthPixels = GetDeviceCaps(nDC, HORZRES)
    ReleaseDC 0, nDC
End Property

Doch in der Access-Bibliothek fehlt diese Möglichkeit. Und in keiner der Bibliotheken der Office-Anwendungen finden Sie eine direkte oder indirekte Möglichkeit, die aktuelle Bildschirmauflösung in Erfahrung zu bringen (die Bildschirmauflösung hängt davon ab, ob der Anwender in den Bildschirmeinstellungen große oder kleine Bildschirmschriften oder eine beliebige Schriftgröße eingestellt hat).

Die gesuchten Werte liefert dagegen immer aktuell die API-Funktion GetDeviceCaps. Sie wird für den Gerätekontext (DC) eines bestimmten Geräts aufgerufen, etwa eines Druckers oder eben des Bildschirms.

Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Public Property Get dpiX() As Long
    Dim nDC As Long
    nDC = GetDC(0)
    dpiX = GetDeviceCaps(nDC, LOGPIXELSX)
    ReleaseDC 0, nDC
End Property
Public Property Get dpiY() As Long
    Dim nDC As Long
    nDC = GetDC(0)
    dpiY = GetDeviceCaps(nDC, LOGPIXELSY)
    ReleaseDC 0, nDC
End Property
Public Property Get TwipsPerPixelX() As Single
    Dim nDC As Long
    nDC = GetDC(0)
    TwipsPerPixelX = 1440 / _        GetDeviceCaps(nDC, LOGPIXELSX)
    ReleaseDC 0, nDC
End Property
Public Property Get TwipsPerPixelY() As Single
    Dim nDC As Long
    nDC = GetDC(0)
    TwipsPerPixelY = 1440 / _        GetDeviceCaps(nDC, LOGPIXELSY)
    ReleaseDC 0, nDC
End Property
Public Property Get ScreenHeightTWIPS() As Single
    Dim nDC As Long
    nDC = GetDC(0)
    ScreenHeightTWIPS = GetDeviceCaps(nDC, VERTRES) * _
     (1440 / GetDeviceCaps(nDC, LOGPIXELSY))
    ReleaseDC 0, nDC
End Property
Public Property Get ScreenWidthTWIPS() As Single
    Dim nDC As Long
    nDC = GetDC(0)
    ScreenWidthTWIPS = GetDeviceCaps(nDC, HORZRES) * _
        (1440 / GetDeviceCaps(nDC, LOGPIXELSX))
    ReleaseDC 0, nDC
End Property

Den Gerätekontext des Bildschirms erhalten Sie über die API-Funktion GetDC, der Sie als Fenster-Handle für den ganzen Bildschirm den Wert 0 übergeben.

Nach der Verwendung des Gerätekontextes müssen Sie daran denken, ihn wieder mit der API-Funktion ReleaseDC freizugeben.

Neben dem Gerätekontext übergeben Sie der Funktion GetDeviceCaps einen Index, zu dem Sie den gewünschten Wert erhalten wollen. Zum Beispiel die Bildschirmhöhe und die Bildschirmbreite liefern auf diese Weise die beiden folgenden Hilfsfunktionen ScreenHeightPixels und ScreenWidthPixels.

In Quellcode 1 finden Sie zunächst die erforderlichen Deklarationen der benötigten API-Funktionen sowie der dazugehörenden Konstanten.

Die fehlende Information über die Bildschirmauflösung erhalten Sie über die Funktion GetDeviceCaps (Beispiele s. Quellcode 2) Sie liefert Ihnen direkt die vertikale und die horizontale Bildschirmauflösung in dpi (Dots per Inch).

Scheinbar sind die vertikale und die horizontale Auflösung immer gleich. Doch sollten Sie sich nicht darauf verlassen – es mag durchaus das eine oder andere Bildschirmgerät mit unterschiedlicher horizontaler und vertikaler Auflösung geben.

Aus der Bildschirmauflösung in dpi können Sie zusätzlich noch den vertikalen und den horizontalen Umrechnungsfaktor für die Maßeinheit TWIPS ermitteln.

Private Type SHFILEOPSTRUCT
    hWnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As String
End Type
Quellcode 5
Private Declare Function SHFileOperation Lib _
    "Shell32.dll" Alias "SHFileOperationA" (lpFileOp _
    As SHFILEOPSTRUCT) As Long
Quellcode 6
Public Function Kill(Files As Variant, Optional ByVal _    AllowUndo As Boolean, Optional ByVal ShowProgress _    As Boolean, Optional ByVal Confirmation As _    Boolean,  Optional ByVal Simple As Boolean, _
    Optional ByVal SysErrors As Boolean, Optional _    ByVal hWnd As Long, Optional UserAborts As Variant _
    ) As Boolean
    Dim l As Long
    Dim nFileOperations As SHFILEOPSTRUCT
    Const FO_DELETE = &H3
    Const FOF_ALLOWUNDO = &H40
    Const FOF_SILENT = &H4
    Const FOF_NOCONFIRMATION = &H10
    Const FOF_SIMPLEPROGRESS = &H100
    Const FOF_NOERRORUI = &H400

Diese ist ein bei vielen externen Steuerelementen (wie etwa den Microsoft Common Controls) verwendeter Standard für bildschirmbezogene Abmessungen. Diese Maßeinheit errechnet sich als 1440tel der horizontalen bzw. vertikalen Bildschirmauflösung, wie sie von GetDeviceCaps geliefert wird (s. Quellcode 3).

Die Bildschirmgröße in TWIPS erhalten Sie dementsprechend über die Funktionen ScreenWidthTWIPS und ScreenHeightTWIPS (s. Quellcode 4)

Eine Datei zu löschen ist in VBA ein Kinderspiel – zum Beispiel mit folgender Anweisung:

Kill "c:\autoexec.bat"

– und schon ist die Datei weg. Und unrettbar verloren.

Vor allem bei vom Anwender ausgelösten Dateilöschungen sollten Sie ihm daher die Windows-übliche Möglichkeit einräumen, gelöschte Dateien (und Ordner) aus dem Papierkorb wieder herzustellen zu können.

Verwenden Sie in solchen Fällen die API-Funktion SHFileOperation (s. Quellcode 6). Bei dieser können Sie wählen, ob die Datei(en) im Papierkorb landen, oder ob sie wie bei der VBA-Kill-Anweisung gleich vollständig gelöscht werden.

Außerdem können Sie die gewohnte Fortschrittsanzeige bieten und einige Einstellungen mehr festlegen (SHFILEOPSTRUCT, Aussehen der Definition s. Quellcode 5).

Ebenso können Sie mit ihr komplette Ordner auf einen Schlag löschen – ein komplizierter, rekursiver Mechanismus mit den VBA-Anwiesungen Kill und RmDir entfällt, mit dem alle untergeordneten Ordner geleert und einzeln gelöscht werden müssten.

    With nFileOperations
    If IsArray(Files) Then
        For l = LBound(Files) To UBound(Files)
            .pFrom = .pFrom & Files(l) & vbNullChar
        Next ''l
        .pFrom = .pFrom & vbNullChar
    ElseIf VarType(Files) = vbObject Then
        If TypeOf Files Is Collection Then
            For l = 1 To Files.Count
                .pFrom = .pFrom & Files(l) & vbNullChar
            Next ''l
            .pFrom = .pFrom & vbNullChar
        End If
    ElseIf VarType(Files) = vbString Then
        .pFrom = Files
        If Right$(.pFrom, 1) <> vbNullChar Then
            .pFrom = .pFrom & vbNullChar
        End If
        If Mid$(.pFrom, Len(.pFrom) - 1, 1) <> _            vbNullChar Then
            .pFrom = .pFrom & vbNullChar
        End If
    End If
    If AllowUndo Then 
      .fFlags = FOF_ALLOWUNDO
    End If
    If Not ShowProgress Then
      .fFlags = .fFlags Or FOF_SILENT
    End If
    If Not Confirmation Then
      .fFlags = .fFlags Or FOF_NOCONFIRMATION
    End If
    If Simple Then
      .fFlags = .fFlags Or FOF_SIMPLEPROGRESS
    End If
    If Not SysErrors Then
      .fFlags = .fFlags Or FOF_NOERRORUI
    End If
    .wFunc = FO_DELETE
    .hWnd = hWnd
    Kill = Not CBool(SHFileOperation(nFileOperations))
    If Not IsMissing(UserAborts) Then
      UserAborts = CBool(.fAnyOperationsAborted)
    End If
    End With
End Function

Die hier vorgestellte Ersatzfunktion Kill (s. Quellcode 7) verhält sich wie das VBA-Original, wenn Sie ihr (wie gewohnt) lediglich den gewünschten Dateinamen übergeben.

Sie können ihr aber auch ein (dimensioniertes oder aktuell mit der Array-Funktion zusammengestelltes) Array oder eine Collection aus einzelnen Datei- und Ordnerpfaden übergeben. Und sie können Wildcards (etwa „*.*“ oder „*.bas“) verwenden.

Die gewünschte Funktionalität legen Sie in den einzelnen optionalen Parametern fest. Sollen die Dateien in den Papierkorb verschoben werden, setzen Sie AllowUndo gleich True. Soll der Windows-übliche Fortschrittsdialog mit Möglichkeit zum Abbrechen des Vorgangs angezeigt werden, setzen Sie ShowProgress gleich True.

Die Rückfrage, ob wirklich gelöscht werden soll, legen Sie mit Confirmation gleich True fest. Eine etwas vereinfachte Fortschrittsanzeige, bei der die Anzeige der gerade bearbeiteten Dateinamen unterbleibt, wählen Sie mit Simple gleich True. Wenn Sie im Falle eines Fehlers die Windows-Anzeige dieses Fehlers beibehalten wollen, setzen Sie SysErrors gleich True.

Unabhängig davon, wie Sie den letztgenannten Parameter setzen, gibt die Funktion Kill den Wert True zurück, wenn ein Fehler aufgetreten ist. Allerdings lässt sich der Fehler nicht näher spezifizieren – Sie müssen auf andere Weise prüfen, was schief gegangen sein könnte (Datei nicht vorhanden, gesperrt u. a.).

Hat der Anwender bei den gelegentlichen Rückfragen des Systems (Löschen einer Systemdatei o. ä.) beispielsweise einzelne Dateien übersprungen, können Sie diese Information über den Parameter UserAborts erhalten, in der Sie dazu eine Variable übergeben müssen. Allerdings müssen Sie auch hierbei wieder selbst herausfinden, welche Dateien übersprungen worden sind.

Private Declare Function GetDesktopWindow _    Lib "user32" () As Long
Private Declare Function SHFormatDrive Lib "shell32" _    (ByVal hWnd As Long, ByVal Drive As Long, ByVal _    fmtID As Long, ByVal Options As Long) As Long
Public Enum fdReturnConstants
  fdRetSuccess = 0
  fdRetError = -1
  fdRetCancelled = -2
  fdRetNotFormattable = -3
  fdRetInvalidDrive = -4
End Enum

Das VBA-Original der Kill-Anweisung können Sie anstelle dieser erweiterten Kill-Funktion weiterhin jederzeit aufrufen. Dazu setzen Sie einfach den Herkunftsbezeichner (Qualifizierer) davor: „VBA.Kill …“.

Sie möchten es dem Anwender ermöglichen, in Ihrem Programm eine Diskette frisch zu formatieren Dann sollten Sie sich nicht lange mit der Entwicklung eigener Formatier-Routinen und -Dialogen aufhalten, sondern dem Anwender den entsprechenden Standard-Dialog anzeigen.

Zum einen ist die dahinter stehende Operation des Betriebssystems als ausgereift und stabil zu betrachten. Zum anderen ist der Standard-Dialog dem Anwender in der Regel vertraut. Und er hat die Möglichkeit, sich zwischen der vollständigen Formatierung und der Schnellformatierung des Datenträgers zu entscheiden, und er kann auch einen Datenträgernamen angeben bzw. einen vorhandenen Namen ändern.

Diesen Standard-Dialog, der unter den verschiedenen Windows-Versionen unterschiedlich aussieht, aber dennoch im wesentlichen die gleiche Funktionalität bietet, erreichen Sie über die API-Funktion SHFormatDrive. Die Funktion ist allerdings weder in im Windows-SDK dokumentiert noch sind Deklaration und Konstanten in den C-Header-Dateien enthalten.

Dennoch sollten Sie die Funktion bedenkenlos und auch zukunftssicher verwenden können, da Microsoft selbst in einem Artikel der Knowledge-Base die dokumentations-üblichen Informationen dazu liefert.

Die Funktion FormatDriveDlg vereinfacht den Aufruf der API-Funktion und bietet zugleich die Möglichkeit, das gewünschte Laufwerk sowohl über den Laufwerksbuchstaben als auch über die MS-DOS-übliche Nummer (beginnend ab 0, also Laufwerk A: gleich 0) zu spezifizieren.

Da der besagte Knowledge-Base-Artikel anmahnt, immer ein Fenster als Bezug zu übergeben, sollten Sie das entsprechende Fenster-Handle eines Forms (hWnd-Eigenschaft) verwenden.

Da im Grunde das Handle des Desktops genauso geeignet ist, können Sie im optionalen Parameter hWnd der Funktion FormatDriveDlg auch 0 übergeben oder ihn ganz weglassen. In der Funktion wird dann über die API-Funktion GetDesktopWindow automatisch das Handle des Desktops ermittelt und verwendet.

Den Erfolg der Aktion meldet die Funktion in ihrem Rückgabewert. Die möglichen Werte sind hier als enumerierte Konstanten bereitgestellt. Bricht der Anwender selbst den Dialog ab (Schaltfläche „Schließen“), ohne die Formatierung gestartet zu haben, wird fdRetCancelled zurückgegeben.

Wurde versehentlich die Kennung eines nicht-formatierbaren Laufwerks übergeben (etwa ein CD-ROM-Laufwerk), wird fdRetNotFormattable zurückgegeben. Alle übrigen Fehler auf Betriebsystemebene werden als fdRetError unspezifiziert gemeldet.

Während für diese Rückgabewerte die API-Funktion SHFormatDrive zuständig ist, wird der Rückgabewert fdRetInvalidDrive von der Funktion FormatDriveDlg selbst generiert, wenn ein „unmöglicher“ Laufwerksbuchstabe oder eine entsprechende Laufwerksnummer übergeben worden ist.

Public Function FormatDriveDlg(Drive As Variant, _
    Optional ByVal hWnd As Long) As fdReturnConstants
    Dim nDriveNumber, nWnd As Long
    Const SHFMT_ID_DEFAULT = &HFFFF&
    Const SHFMT_OPT_FULL = 1
    If IsNumeric(Drive) Then
        Select Case CLng(Drive)
             Case 0 To 25
                 nDriveNumber = CLng(Drive)
             Case Else
                 FormatDriveDlg = fdRetInvalidDrive
                 Exit Function
        End Select
    ElseIf VarType(Drive) = vbString Then
        Select Case UCase$(Left$(Drive, 1))
            Case "A" To "Z"
                nDriveNumber = _                    Asc(UCase$(Left$(Drive, 1))) - 65
            Case Else
                FormatDriveDlg = fdRetInvalidDrive
                Exit Function
        End Select
    End If
    If hWnd = 0 Then
        nWnd = GetDesktopWindow()
    Else
        nWnd = hWnd
    End If
    FormatDriveDlg = SHFormatDrive(nWnd, nDriveNumber, _
        SHFMT_ID_DEFAULT, SHFMT_OPT_FULL)
End Function

Für die meisten Systemordner gibt es zwar Standardnamen und sie befinden sich meistens auch an Standardplätzen im Dateisystem.

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