Tekst informacyjny o polityce Cookies Close   
    
 
         
• Strona główna
• 1. Linki
• 3. Kontakt: e-Mail
 
         
• 1. Baza danych
• 2. Tabele i kwerendy
• 3. Formularze
• 4. Raporty
• 5. Moduły i makra
• 6. Obsługa błędów
 
    

II.   VBA 

    
• 1. Okna Accessa
• 2. Okna Formularzy
• 3.Okna Dialogowe
• 4. Tekst
• 5. Liczby
• 6. Pliki
• 7. Inne
 
    

III.   API 

    
• 1. Ogólnie o API
• 2. Funkcje API
• 3. System
• 4. Praca z oknami
• 5. Okna dialogowe
• 6. API - Inne
 
         
• 1. Bitmapy 24 Bit
• 2. GDI i HDC
• 3. Kody kreskowe
• 4. Formant Image
• 5. FreeImage.dll
 
    

V.   Inne 

    
• 1. Shell i MsDOS
• 2. Kontrolki
• 3. ६ԼҚ ਸ
• 4. Unikod

 
Odwiedzin:

Logo AccessFAQ• II.3. VBA - Okna dialogowe •

3.1 Jak pobrać uchwyt okna dialogowego, przecież wywołanie takiego okna wstrzymuje dalsze wykonywanie kodu ?
3.2 Jak wyświetlić okno komunikatu, tak by pojawiło się na ekranie, gdy okno Accessa jest (zminimalizowane) nieaktywne przez 3 sek. ?
3.3 Jak zmienić wprowadzane znaki w InputBox'ie na ****** ?
3.4 Jak sprawdzić, czy w InputBox'ie kliknięto przycisk Anuluj czy OK ?
3.5 Jak z MsgBox'a zrobić prymitywny pasek postępu ?
3.6 Jak do MsgBox'a wstawić wbudowany wskaźnik postępu MS Access ?
3.7 Jak z okna MsgBox'a skopiować tekst komunikatu, zamiast go żmudnie przepisywać ?
3.8 Jak zmienić tekst na przyciskach w oknie MsgBox'a ?
 

3.1 Jak pobrać uchwyt okna dialogowego, przecież wywołanie takiego okna wstrzymuje dalsze wykonywanie kodu ?

Private Declare Function GetActiveWindow Lib "user32" () As Long
' poniższe funkcje zadeklarowano jedynie dla potrzeb testu
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long


Private Sub btnTest_Click()
' uruchamiamy Timer, wyświetlamy okno dialogowe i pozostałą część operacji wykonujemy w Form_Timer
Me.TimerInterval = 1500
MsgBox "Okno dialogowe, którego szukamy.", vbExclamation
End Sub


Private Sub Form_Timer()
Dim hActiveWind As Long
Dim hWind As Long

' wyłączamy Timer
Me.TimerInterval = 0
hActiveWind = GetActiveWindow

' Test - sprawdźmy, czy znaleźliśmy właściwe okno
hWind = FindWindowEx(hActiveWind, 0&, _
"Static", vbNullString)
' ukryj ikonę vbExclamation
ShowWindow hWind, False
hWind = FindWindowEx(hActiveWind, hWind, _
"Static", vbNullString)
SetWindowText hWind, "Znaleźliśmy je !" & vbNewLine & _
" Uchwyt okna = " & hActiveWind

End Sub

 ΔΔΔ 

 

3.2 Jak wyświetlić okno komunikatu, tak by pojawiło się na ekranie,
gdy okno Accessa jest zminimalizowane (nieaktywne) ?

Private Declare Function MessageBox Lib "user32" _
Alias "MessageBoxA" _
(ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) As Long
Private Const MB_SYSTEMMODAL = &H1000&
Private Const MB_TOPMOST = &H40000
Private Const MB_YESNO = &H4&
Private Const MB_ICONQUESTION = &H20&
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Const SW_MINIMIZE = 6
Private Const SW_RESTORE = 9


' przykładowe wywołanie:
Private Sub btnTest_Click()
' minimalizujemy Access'a uruchamiamy Timer
ShowWindow Application.hWndAccessApp, SW_MINIMIZE
Me.TimerInterval = 3000
End Sub


Private Sub Form_Timer()
Dim hWind As Long
Dim lRet As Long

' w timerze formularza sprawdzamy, czy Access jest aktywny porównując uchwyt aktywnego okna z uchwytem okna Accessa
If GetActiveWindow <> Application.hWndAccessApp Then
' wyłączmay Timer
Me.TimerInterval = 0
lRet = zbSysModalMsgBox( _
"Czy zamknąć bazę danych ?", _
"Nieaktywny Access ", _
MB_SYSTEMMODAL Or _
MB_TOPMOST Or MB_YESNO Or _
MB_ICONQUESTION)
If lRet = vbNo Then
    ShowWindow Application.hWndAccessApp, SW_RESTORE
    Me.TimerInterval = 3000
Else
    DoCmd.Quit
End If
End If

End Sub


' wyświetla okno komunikatu, zwraca wartość przycisku, który wybrał użytkownik
Private Function zbSysModalMsgBox( _
sMsg As String, _
sCaption As String, _
lType As Long) As Long

    zbSysModalMsgBox = MessageBox( _
Application.hWndAccessApp, _
sMsg, sCaption, lType)

End Function

 ΔΔΔ 

 

3.3 Jak zmienić wprowadzane znaki w InputBox'ie na ****** ?

Private Declare Function GetFocus Lib "user32" () As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal Msg As Long, _
wParam As Any, _
lParam As Any) As Long
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_GETTEXT = &HD
Private Const WM_SETTEXT = &HC
Private Const EM_SETSEL = &HB1
Private Const MY_PASSWORD_CHAR As Long = 42
Private sDefPsw As String


' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim sRet As String

sDefPsw = "Domyślne hasło"
' uruchom Timer formularza
Me.TimerInterval = 50
' wywołaj InputBox i wpisz gwiazdki, bo przez chwilę jest widoczny jawny tekst,
' reszta zostanie wykonana w Form_Timer
sRet = InputBox("Wprowadź tekst:", "Wpisz hasło", _
String(Len(sDefPsw), _
MY_PASSWORD_CHAR))
If Len(sRet) = 0 Then
    MsgBox "Anulowano lub usunięto tekst w InputBox'ie." & _
vbNewLine & "Zobacz:" & vbNewLine & _
"Jak sprawdzić, czy w InputBox'ie" & _
vbNewLine & _
"kliknięto przycisk Anuluj czy OK ?", _
vbExclamation
Else
    MsgBox sRet
End If

End Sub


Private Sub Form_Timer()
Dim hWind As Long

Me.TimerInterval = 0
' hWind = FindWindowEx( _
GetActiveWindow, ByVal 0&, _
"Edit", vbNullString)
' lub
hWind = GetFocus
If hWind = 0 Then Exit Sub
SendMessage hWind, _
EM_SETPASSWORDCHAR, _
ByVal MY_PASSWORD_CHAR, _
ByVal 0&
SendMessage hWind, WM_SETTEXT, _
ByVal 0&, ByVal sDefPsw
SendMessage hWind, EM_SETSEL, _
ByVal 0&, ByVal -1&

End Sub

 ΔΔΔ 

 

3.4 Jak sprawdzić, czy w InputBox'ie kliknięto przycisk Anuluj czy OK ?

grupa: pl.comp.bazy-danych.msaccess
wątek: InputBox - Anuluj Czy ""
przedstawił: Krzysztof Naworyta



Private Sub knInputBoxCancelOrOK()
Dim s As String

s = InputBox("Wpisz coś")

If StrPtr(s) Then
MsgBox "wpisano: """ & s & """", , "knInputBox"
Else
MsgBox "Wciśnięto Anuluj", , "knInputBox"
End If

End Sub


' dla tych co nie lubią nieudokumentowanych funkcji:
Private Declare Function lstrcpy Lib "kernel32" _
Alias "lstrcpyA" _
(ByVal lpString1 As String, _
ByVal lpString2 As String) As Long


Private Sub zbInputBoxCancelOrOK()
Dim sOut As String

sOut = Space$(255)
lstrcpy sOut, InputBox("Wprowadź tekst:", "zbInputBox")
sOut = RTrim$(sOut)

If Len(sOut) = 0 Then
    MsgBox "Anulowano.", , "zbInputBox"
Else
    sOut = Left$(sOut, InStr(1, sOut, _
vbNullChar, vbBinaryCompare) - 1)
    MsgBox "Wprowadzono:[" & sOut & "]", , _
"zbInputBoxCancelOrOK"
End If

End Sub

 ΔΔΔ 

 

3.5 Jak z MsgBox'a zrobić prymitywny pasek postępu ?


   Przykład:  • vba12a_05  •  52 KB  •  status: FREE  Pobrano    razy   


Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetDlgItem Lib "user32" ( _
ByVal hDlg As Long, _
ByVal nIDDlgItem As Long) As Long
Private Declare Function EnableWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal fEnable As Long) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal Msg As Long, _
wParam As Any, _
lParam As Any) As Long
Private Const WM_CLOSE = &H10
Private Const WM_SETTEXT = &HC
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function MoveWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Private Const MY_SIZE_PROGBAR As Long = 32
Private Const MY_CHAR_PROGBAR As String = "#"
Private Const MY_CHR_END As String = "="
Private Type typeMSGBOX
hWndMsg As Long
hBtnOK As Long
hWndStatic As Long
End Type
Private msg As typeMSGBOX
Private lMaxFor As Long
Private Const MY_ID_BTN_OK As Long = 2
Private Const MY_CLASS_STATIC As String = "Static"


' zainicjuj pasek postępu
Private Sub zbIniMsgProgBar()

' uruchom Timer
Me.TimerInterval = 200
' zablokuj odświeżanie pulpitu
LockWindowUpdate GetDesktopWindow
' wywołaj MsgBox, by zrobić z niego ProgressBar
MsgBox "" & vbNewLine & vbNewLine & _
String(MY_SIZE_PROGBAR, _
MY_CHAR_PROGBAR), vbExclamation
LockWindowUpdate False

End Sub


Private Sub Form_Timer()
Dim i As Integer
Dim rctOK As RECT
Dim rctMsg As RECT
Dim hTmp As Long
On Error Resume Next

Me.TimerInterval = 0
With msg
' pobierz uchwyt MsgBox'a i przycisku OK
.hWndMsg = GetActiveWindow
.hBtnOK = GetDlgItem(.hWndMsg, MY_ID_BTN_OK)
' deaktywuj przycisk OK
EnableWindow .hBtnOK, False
' pobierz wymiary okna MsgBox i położenie btnOK
GetWindowRect .hWndMsg, rctMsg
GetWindowRect .hBtnOK, rctOK
' przytnij okno MsgBox nad przyciskiem btnOK
With rctMsg
    MoveWindow msg.hWndMsg, .Left, .Top, _
.Right - .Left, _
rctOK.Top - .Top, True
End With
DoEvents
' szukaj ostatniego okna klasy "Static"
Do
    hTmp = FindWindowEx(.hWndMsg, ByVal hTmp, _
MY_CLASS_STATIC, vbNullString)
    If hTmp <> 0 Then .hWndStatic = hTmp
Loop Until hTmp = 0

' wyzeruj tekst
SendMessage .hWndStatic, WM_SETTEXT, _
ByVal 0&, ByVal vbNullString
End With

' odblokuj odświeżanie
LockWindowUpdate False
DoEvents
' uruchom procedurę przetwarzania
Call zbUpdateMsgProgBar(MY_CHR_END)

End Sub


' ze względu na wykorzystanie okna MsgBox'a jako właściciela paska postępu, musimy poniżej rozpisać całą procedurę przetwarzania
Private Sub zbUpdateMsgProgBar( _
Optional sChrEnd As String = " ")
Dim snCountStep As Single
Dim sStr As String
Dim i As Long
Dim j As Long
Dim k As Long

snCountStep = MY_SIZE_PROGBAR / lMaxFor
REM If Len(sChrEnd) = 0 Then sChrEnd = " "

For i = 0 To lMaxFor
j = CLng(i * snCountStep)
If j > k Then
k = j
sStr = "Wykonuję operację: " & _
CLng(j / snCountStep) & " z " & lMaxFor & _
vbNewLine & vbNewLine & _
String(k, MY_CHAR_PROGBAR)
sStr = sStr & String(MY_SIZE_PROGBAR - k, sChrEnd)
SendMessage msg.hWndStatic, WM_SETTEXT, _
ByVal 0&, ByVal sStr
End If
Sleep 10&
Next

' wtrzymaj działanie, <= tylko w celach poglądowych
Sleep 500&
' zamknij okno MsgBox
EnableWindow msg.hBtnOK, True
SendMessage msg.hWndMsg, WM_CLOSE, _
ByVal 0&, ByVal 0&

End Sub


' przykładowe wywołanie:
Private Sub btnTest_Click()
' ustaw ilość operacji
lMaxFor = 250
zbIniMsgProgBar
End Sub

 ΔΔΔ 

 

3.6 Jak do MsgBox'a wstawić wbudowany wskaźnik postępu MS Access ?


   Przykład:  • vba12a_06  •  52 KB  •  status: FREE  Pobrano    razy   


Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
Private Declare Function MoveWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Declare Function EnableWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal fEnable As Long) As Long
Private Declare Function GetDlgItem Lib "user32" ( _
ByVal hDlg As Long, _
ByVal nIDDlgItem As Long) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal Msg As Long, _
wParam As Any, _
lParam As Any) As Long
Private Const WM_CLOSE = &H10
Private Const WM_SETTEXT = &HC
Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Const SM_CYCAPTION = 4&
Private Const SM_CXDLGFRAME = 7&
Private Const SM_CYDLGFRAME = 8&
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Type typeMSGBOX
hWndMsg As Long
hBtnOK As Long
hWndStatic As Long
End Type

Private hOldParent As Long' uchwyt rodzica wskaźnika postępu
Private hProgBar As Long' uchwyt okna wskaźnika postępu
Private hStatBar As Long' uchwyt okna StatusBar
Private rctProgBar As RECT' struktura RECT wskaźnika postępu
Private fStatBarVisible As Boolean' początkowy stan paska stanu
Private lMySizeProgBar As Long' wysokość wskaźnika postępu (od 20 do 50 pikseli)
Private msg As typeMSGBOX' uchwyty okien MsgBox'a

Private Const MY_ID_BTN_OK As Long = 2
Private Const MY_CLASS_STATIC As String = "Static"
Private Const MY_TEXT_MSGBOX As String = "qwerty"


Private Sub zbIniMsgProgBar( _
Optional lSizeProgBar As Long = 28)

fStatBarVisible = Application.GetOption("Show Status Bar")
' możesz ukryć pozostałości paska stanu
' Application.SetOption ("Show Status Bar"), False

' doświadczalnie dobrane ograniczenia
If lSizeProgBar > 50 Then
    lMySizeProgBar = 50
ElseIf lSizeProgBar < 21 Then
    lMySizeProgBar = 21
Else
    lMySizeProgBar = lSizeProgBar
End If

' uruchom Timer
Me.TimerInterval = 100
' wywołaj MsgBox, by wstawić do niego wskaźnik postępu
MsgBox MY_TEXT_MSGBOX

End Sub


Private Sub Form_Timer()
On Error GoTo ErrHandler
Dim rctMsg As RECT' struktura RECT okna komunikatu
Dim rctStatic As RECT' struktura RECT pola tekstowego MsgBox
Dim lHCaption As Long' wysokość paska tytułowego okna
Dim lHBorder As Long' wysokość okna dialogowego
Dim lWBorder As Long' szerokość okna dialogowego
Dim lWProgBar As Long' przewidywana szerokość wskaźnika postępu
Dim lWMsg As Long' szerokość okna MsgBox
Dim lHMsg As Long' wysokość okna MsgBox
Dim lRet As Long' zwracana wartość
Const MY_MARGIN As Long = 20' margines MsgBox'a z prawej strony

Me.TimerInterval = 0
lWProgBar = (lMySizeProgBar - 12&) * 20& + 6&
' pobierz wysokość paska tytułowego okna
' i wymiary obramowania okna
lHCaption = GetSystemMetrics(SM_CYCAPTION)
lHBorder = GetSystemMetrics(SM_CXDLGFRAME)
lWBorder = GetSystemMetrics(SM_CYDLGFRAME)

msg.hWndMsg = GetActiveWindow
hStatBar = FindWindowEx( _
Application.hWndAccessApp, _
ByVal 0&, "OStatbar", vbNullString)
hProgBar = FindWindowEx( _
hStatBar, ByVal 0&, _
"OStatProg", vbNullString)

' pobierz wymiary okna MsgBox
GetWindowRect msg.hWndMsg, rctMsg

' znajdź uchwyt przycisku OK
msg.hBtnOK = GetDlgItem(msg.hWndMsg, _
MY_ID_BTN_OK)
ShowWindow msg.hBtnOK, False
EnableWindow msg.hBtnOK, False
DoEvents


' niestety MS zmienił ID okna klasy Static w Acc2k
    ' znajdź uchwyt okna tekstowego
    ' REM hStatic = GetDlgItem(hDlgMsg, cIdStatic)

' tutaj zakładam, że okno to jest ostatnim dzieckiem okna MsgBox
' W razie problemów można pobrać tekst okna i porównać
' z MY_TEXT_MSGBOX= "qwerty"



msg.hWndStatic = 0
Do
    lRet = FindWindowEx( _
msg.hWndMsg, _
ByVal msg.hWndStatic, _
MY_CLASS_STATIC, _
vbNullString)
    If lRet = 0 Then Exit Do
    msg.hWndStatic = lRet
Loop Until lRet = 0&

' pobierz wymiary okna tekstowego
GetWindowRect msg.hWndStatic, rctStatic
' pobierz wymiary wskaźnika postępu
GetWindowRect hProgBar, rctProgBar
' szerokość okna MsgBox
lWMsg = rctMsg.Right - rctMsg.Left

' jeżeli wskaźnik zaawansowania jest szerszy niż okno MsgBox
With rctMsg
If lWProgBar > lWMsg - 20& Then
    .Left = .Left - ((lWProgBar - lWMsg) \ 2&) - MY_MARGIN
    .Right = .Right + ((lWProgBar - lWMsg) \ 2&) + MY_MARGIN
End If

' przytnij okno MsgBox poniżej okna tekstowego i powiększ o lMySizeProgBar
.Bottom = .Bottom - (.Bottom - rctStatic.Bottom) + _
lMySizeProgBar
lHMsg = .Bottom - .Top
End With
' ustaw nowego rodzica dla wskaźnika postępu
hOldParent = SetParent(hProgBar, msg.hWndMsg)

With rctMsg
' ustaw wymiary okna MsgBox
MoveWindow msg.hWndMsg, .Left, .Top, _
.Right - .Left, .Bottom - .Top, True
' ustaw położenie i wymiar wskaźnika postępu
MoveWindow hProgBar, 0, _
lHMsg - lMySizeProgBar - _
(lHCaption + lHBorder + lWBorder), _
22& * lMySizeProgBar, _
lMySizeProgBar, True

' pobierz wymiary okna tekstowego
GetWindowRect msg.hWndStatic, rctStatic
' powiększ okno Static na przyjęcie dłuższego tekstu
MoveWindow msg.hWndStatic, rctStatic.Left - .Left, _
(rctStatic.Top - .Top) - (lHCaption + _
lHBorder + lWBorder), _
.Right - .Left - 20&, _
rctStatic.Bottom - rctStatic.Top, True
End With

LockWindowUpdate False
Call zbUpdateMsgProgBar

ExitHere:
    Exit Sub
ErrHandler:
DoCmd.SetWarnings True
LockWindowUpdate False
MsgBox Err.Description
Resume ExitHere
End Sub


' ze względu na wykorzystanie MsgBox'a,
' musimy poniżej wpisać całą
' procedurę przetwarzania pętli

Private Sub zbUpdateMsgProgBar()
Dim sStr As String
Dim lMyForTo As Long
Dim i As Long

' musimy znać zakres wywoływanej pętli
lMyForTo = 250
' zainicjuj pasek postępu
Application.SysCmd acSysCmdInitMeter, " ", lMyForTo

' wykonaj przykładową pętlę
For i = 1 To lMyForTo
Application.SysCmd acSysCmdUpdateMeter, i
DoEvents
sStr = "Wykonuję operację: " & i & " z " & lMyForTo
SendMessage msg.hWndStatic, WM_SETTEXT, _
ByVal 0&, ByVal sStr
' zwolnij pętlę w celach poglądowych
Sleep 10&
Next

' usuń wskaźnik postępu
Call zbRemoveMsgProgBar

End Sub


Private Sub zbRemoveMsgProgBar()

' przywróć wskaźnika postępu rodzicowi
hOldParent = SetParent(hProgBar, hOldParent)

' przywróć stare ustawienia wskaźnika postępu
With rctProgBar
    MoveWindow hProgBar, 0&, 0&, _
.Right - .Left, .Bottom - .Top, True
End With

' zamknij okno MsgBox i usuń pasek postępu
EnableWindow msg.hBtnOK, True
SendMessage msg.hWndMsg, WM_CLOSE, _
ByVal 0&, ByVal 0&
Application.SysCmd acSysCmdClearStatus
Application.SysCmd acSysCmdRemoveMeter
Application.SetOption ("Show Status Bar"), fStatBarVisible
DoEvents

End Sub


Private Sub btnTest_Click()
On Error Resume Next
LockWindowUpdate GetDesktopWindow
Call zbIniMsgProgBar(28)
LockWindowUpdate False
End Sub

 ΔΔΔ 

 

3.7 Jak z okna MsgBox'a skopiować tekst komunikatu, zamiast go żmudnie przepisywać ?

grupa: pl.comp.bazy-danych.msaccess
wątek: A to ci wynalazek... [NTG]
przedstawił: Piotr Lipski



<cyt>
Totalnie NTG, ale założę się o cokolwiek, że 95% czytających tego posta zaklnie siarczyście w duszy, że tego nie znało wcześniej...

Mianowicie...


    Dowolny MsgBox z dowolnej aplikacji Windows ma tę właściwość, że reaguje (poprawnie!) na Ctrl-C. Wystarczy potem odpalić notepada i wykonać Ctrl-V...



Przyznać się, kto ile razy w życiu przepisywał jakiś długachny komunikat błędu ... :)
</cyt>

 ΔΔΔ 

 

3.8 Jak zmienić tekst na przyciskach w oknie MsgBox'a ?


   Przykład:  • vba12a_08  •  52 KB  •  status: FREE  Pobrano    razy   


grupa: pl.comp.bazy-danych.msaccess
wątek: Nazwy przycisków w MsgBox
przedstawił: Zbigniew Bratko



Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
Private aBtnTitle(0 To 2) As String



Private Sub btnTest_Click()

Me.TimerInterval = 140
Call LockWindowUpdate(GetDesktopWindow)
' przypisz tytuły dla poszczególnych przycisków okna
aBtnTitle(0) = "Pierwszy"
aBtnTitle(1) = "Drugi"
aBtnTitle(2) = "Trzeci"
'MsgBox "Mój komunikat !", vbYesNo
MsgBox "Mój komunikat !", vbAbortRetryIgnore

End Sub


Private Sub Form_Timer()
Dim hWind As Long
Dim hBtn As Long
Dim i As Long

On Error Resume Next
Me.TimerInterval = 0
' pobierz uchwyt aktywnego okna
hWind = GetActiveWindow

' szukaj przycisków w oknie MsgBox'a i zmieniaj kolejno tytuły
hBtn = FindWindowEx(hWind, 0&, _
"Button", vbNullString)

Do Until hBtn = 0
SetWindowText hBtn, aBtnTitle(i)
hBtn = FindWindowEx(hWind, hBtn, _
"Button", vbNullString)
i = i + 1
Loop

Call LockWindowUpdate(False)
On Error GoTo 0

End Sub

 ΔΔΔ