Czasami w trakcie działania aplikacji MS Access potrzebujemy sprawdzić jaki tytuł (lub tekst) ma okno w systemie Windows.
MS Access posiada właściwości pozwalające na odczyt tytułów niektórych okien. Jest to właściwość obiekt.Caption
obiektu formularz i obiektu raport. Właściwości obiekt.Caption nie należy mylić z właściwością
obiekt.Name, gdyż ta ostatnia zwraca nazwę obiektu, która została podana w trakcie zapisywania projektu.
Nazwa ta jest widoczna w „Oknie nawigacji”, dawniej zwanym „Oknem bazy danych”.
Warto pamiętać, że jeżeli w oknie „Arkusz właściwości”, w trybie „Projektowanie”, nie nadamy właściwości Tytuł (Caption) jakiejkowiek wartości (pozostawimy to pole puste), to otwarty formularz (raport) będzie miał tytuł odpowiadający jego nazwie, a właściwość obiekt.Caption będzie ciągiem zerowej długości "". Jak widać, okno formularza (raportu) może mieć tytuł odpowiadający nazwie obiektu obiekt.Name, lub jego tytułowi obiekt.Caption (jeżeli takowa właściwość została ustawiona w oknie „Projektowanie”)
Zagadnienie pobrania tytułu okna jest bardziej skomplikowane, w przypadku pobierania tytułu okna Aplikacji (napis na pasku tytułowym okna MS Access). Teoretycznie sprawa jest niby prosta. Tytuł okna bazy danych przechowywany jest we właściwości CurrentDb.Properties("AppTitle"), ale w przypadku próby pobrania tej właściwości, gdy nie jest ona ustawiona w oknie „Opcje programu Access/Bieżąca baza danych/Tytuł aplikacji”, program MS Access wygeneruje błąd Error.Number = 3270 i wyświetli okno komunikatu o treści:
Aby nasz kod działał prawidłowo, musimy obsłużyć błąd nr 3270, generowany przy próbie odczytu nieistniejącej właściwości "AppTitle", by wyświetlić odpowiednią informację, że nasza aplikacja nie ma ustawionego tytułu.
MsgBox Forms("NazwaFormularza").Caption '(formularz musi być otwarty) ' lub MsgBox Me.Caption '(dla bieżącego formularza) ' podobnie dla raportu MsgBox Reports("NazwaRaportu").Caption '(raport musi być otwarty) ' lub MsgBox Me.Caption '(dla bieżącego raportu) ' Okno MS Access ' dla okna bieżącej aplikacji musimy obsłużyć błąd nr 3270, ' generowany przy próbie odczytu nieistniejącej właściwości "AppTitle": Private Const conPropNotFoundError = 3270 On Error Resume Next MsgBox CurrentDb.Properties("AppTitle") ' właściwość musi być ustawiona If Err.Number = conPropNotFoundError Then MsgBox "Bieżąca Aplikacja:" & vbNewLine & _ CurrentDb.Name & vbNewLine & _ "nie posiada tytułu." Err.Clear End If On Error GoTo 0
Ale nie zawsze jest tak prosto. Czasami potrzebujemy pobrać tekst (tytuł) okna aplikacji, która nie udostępnia metody pozwalajacej
na pobranie tekstu okna. Wtedy z pomocą przychodzi interfejs Windows API i jego dwie funkcje:
• GetWindowTextLength
- zwracającą długość tekstu okna o przekazanym w argumencie uchwycie hwnd
• GetWindowText
- zwracającą długość pobranego do buforu tekstu okna, a w buforze właściwy tekst okna o uchwycie hwnd.
Option Compare Database Option Explicit ' • Function GetTextWindow(hWind As Long;[LongLong];[LngPtr]) As String ' -------------------------------------------------------------- ' autor: Zbigniew Bratko - 01.2016 ' [hWind] - uchwyt okna, którego tytuł (tekst) będzie pobierany ' w środowisku 32 bitowym liczba typu Long ' w środowisku 64 bitowym liczba typy LongLong ' w środowisku VBA7 może być typu LongPtr ' [Out] - zwraca tytuł (tekst) okna ' Przy niepowodzeniu zwraca ciąg zerowej długości "" ' #If VBA7 Then ' Środowisko VBA 7 - zarówno 32 jak i 64 bitowe Private Declare PtrSafe Function GetWindowText Lib "user32" _ Alias "GetWindowTextA" _ (ByVal hwnd As LongPtr, _ ByVal lpString As String, _ ByVal cch As Long) As Long Private Declare PtrSafe Function GetWindowTextLength Lib "user32" _ Alias "GetWindowTextLengthA" ( _ ByVal hwnd As LongPtr) As Long #Else ' Środowisko VBA 6 - tylko 32 bitowe Private Declare Function GetWindowText Lib "user32" _ Alias "GetWindowTextA" _ (ByVal hwnd As Long, _ ByVal lpString As String, _ ByVal cch As Long) As Long Private Declare Function GetWindowTextLength Lib "user32" _ Alias "GetWindowTextLengthA" ( _ ByVal hwnd As Long) As Long #End If ' Funkcja własna GetTextWindow #If VBA7 Then ' Deklaracja funkcji - zarówno w 32 jak i 64 bitowym środowisku VBA 7 Public Function GetTextWindow(hWind As LongPtr) As String #Else ' Deklaracja funkcji - tylko 32 bitowe środowisko VBA 6 Public Function GetTextWindow(hWind As Long) As String #End If Dim sBuffer As String Dim lLenText As Long ' pobierz długość tekstu okna lLenText = GetWindowTextLength(hWind) ' uwzględnij dodawany znak końca ciągu znaków lLenText = lLenText + 1 ' przygotuj buffor na przyjęcie tekstu sBuffer = String(lLenText, vbNullChar) ' pobierz długość zwróconego tekstu lLenText = GetWindowText(hWind, sBuffer, lLenText) ' utnij nadmiarowy ciąg znaków vbNullChar w buforze GetTextWindow = Left$(sBuffer, lLenText) End Function ' przykładowe wywołanie: Private Sub btnTest_Click() ' pobierz tytuł okna bieżącej aplikacji MS Access MsgBox GetTextWindow(Application.hWndAccessApp) Exit Sub
Brak komentarzy:
Prześlij komentarz