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. Das kann u. a. für die Auslegung der Größe von For-mularen sehr interessant sein. Sie lernen, wie Sie Dateien entgültig 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 beschriebenen Funktionen 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 den jeweiligen Index, zu dem Sie den gewünschten Wert erhalten wollen. über die beiden Hilfs-funktionen ScreenHeightPixels und ScreenWidthPixels erhalten Sie auf diese Weise z. B. die Bildschirmhöhe und die Bildschirmbreite.
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 kann 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 1440stel 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 zwar unrettbar verloren.
Vor allem bei vom Anwender ausgelösten Dateilöschungen sollten Sie ihm die Windows-übliche Möglichkeit einräumen, gelöschte Dateien und Ordner aus dem Papierkorb wieder herstellen 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 ge-wohnte Fortschrittsanzeige bieten und einige zusätzliche Einstellungen 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-Anweisungen Kill und RmDir entfällt, da mit diesem Mechanismus 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 dieser Ersatzfunktion 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 der 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 Fall 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, z. B. Datei nicht vorhanden, gesperrt u. ä.
Hat der Anwender bei den gelegentlichen Rückfragen des Systems (wie etwa 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 bleibt Ihnen auch hierbei nur übrig, 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 Formatier-Dialoge 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. Außerdem hat er 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 Betriebssystemebene 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