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• III.5. API - Okna dialogowe:
          - Otwórz plik / Zapisz plik •

5.1 Jak wyświetlić okno dialogoweOtwórz plik " (możliwy wybór wielokrotny) lub
Zapisz plik " i pobrać elementy składowe ścieżki pliku (przy wyborze jednego pliku) ?
5.2 Jak wyświetlić okno dialogoweOtwórz plik " lub " Zapisz plik " - wersja uproszczona
(wybór tylko jednego pliku) ?
5.3 Jak wyświetlić okno dialogowe " Wybierz kolor " ?
5.4 Jak wyświetlić okno dialogowe " Wybierz folder " i pobrać nazwę pliku ?
 

5.1 Jak wyświetlić okno dialogoweOtwórz plik " (możliwy wybór wielokrotny) lub " Zapisz plik " i pobrać elementy składowe ścieżki pliku (przy wyborze jednego pliku) ?

Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
lStructSize As Long 'wielkość struktury w bajtach
hwndOwner As Long 'uchwyt okna, z poziomu którego otwierane jest okno dialogowe, jeżeli 0 to okno dialogowe nie ma właściciela
hInstance As Long  
lpstrFilter As String 'wskaźnik do bufora zawierającego ułożone parami i zakończone znakiem vbNullChar ciągi znaków: "nazwa opisowa" & vbNullChar & "maska" & vbNullChar, łańcuch musi kończyć się podwójnym znakiem vbNullChar
lpstrCustomFilter As Long  
nMaxCustrFilter As Long  
nFilterIndex As Long 'jaki typ pliku z listy w lpstrFilter ma być domyślnym (pary ciągów numerowne są od 1)
lpstrFile As String 'kompletna ścieżka z nazwami wybranych plików. Poszczególne nazwy plików są oddzielane od siebie znakiem vbNullChar, a cały łańcuch kończy podwójny vbNullChar
nMaxFile As Long 'maksymalny rozmiar zwracanego ciągu lpstrFile
lpstrFileTitle As String 'nazwy wybranego pliku
nMaxFileTitle As Long 'maksymalny rozmiar zwracanego ciągu lpstrFileTitle
lpstrInitialDir As String 'domyślny katalog wyboru
lpstrTitle As String 'tekst tytułu okna
flags As Long 'flagi określających właściwości wyświetlanego okna dialogowego
nFileOffset As Integer 'przesunięcie do bajtów nazwy pliku
nFileExtension As Integer 'przesunięcie do bajtów rozszerzenia pliku pliku
lpstrDefExt As String 'domyślne rozszerzenie pliku
lCustrData As Long  
lpfnHook As Long  
lpTemplateName As Long  
End Type

Public Const OFN_READONLY = &H1'zaznacz opcję CheckBox'a: "Otwórz tylko do odczytu"
Public Const OFN_OVERWRITEPROMPT = &H2'tylko " Zapisz plik " - przy wyborze istniejącego pliku wyświetlaj komunikat: "Czy zamienić istniejący plik ?"
Public Const OFN_HIDEREADONLY = &H4'niewidoczny jest CheckBox: "Otwórz tylko do odczytu"
Public Const OFN_NOCHANGEDIR = &H8'nie zmieniaj bieżącej ścieżki Windows na wybraną w oknie dialogowym
Public Const OFN_SHOWHELP = &H10'pokaz przycisk pomocy.
Public Const OFN_NOVALIDATE = &H100'nie sprawdzaj poprawności wybranego pliku.
Public Const OFN_ALLOWMULTISELECT = &H200'tylko w " Otwórz plik " - zezwól na wybieranie wielu plików
Public Const OFN_PATHMUSTEXIST = &H800'wybór możliwy tylko dla istniejącej ścieżki
Public Const OFN_FILEMUSTEXIST = &H1000'pozwól wybrać tylko istniejące pliki
Public Const OFN_CREATEPROMPT = &H2000'tylko w " Otwórz plik " - pytaj przed utworzeniem nowego pliku
Public Const OFN_SHAREAWARE = &H4000'ignoruj błędy współużytkowania plików
Public Const OFN_NONETWORKBUTTON = &H20000'nie pokazuj przycisku sieć
Public Const OFN_NODEREFERENCELINKS = &H100000'po wybrania skrótu'(.lnk lub .pif), zwracaj skrót, a nie związany plik
Public Const OFN_EXPLORER = &H80000'otworz okno dialogowe typu Explorer dla "Otwórz plik" - opcja wyboru wielokrotnego
Private Const MY_TITLE_SAVE As String = " Zapisz jako: "
Private Const MY_TITLE_OPEN As String = " Otwórz plik: "
Private Const MY_MAX_LEN As Long = 260
' powiększony buffor dla przypadku wielokrotnego wyboru plików
Private Const MY_MAX_BUFFER As Long = &H4000 ' 256 * 64
Public Const MY_FLAGS_SAVE As Long = _
OFN_NOCHANGEDIR Or _
OFN_PATHMUSTEXIST Or _
OFN_HIDEREADONLY Or _
OFN_NONETWORKBUTTON Or _
OFN_OVERWRITEPROMPT Or _
OFN_READONLY Or _
OFN_EXPLORER
Public Const MY_FLAGS_OPEN As Long = _
OFN_NOCHANGEDIR Or _
OFN_PATHMUSTEXIST Or _
OFN_HIDEREADONLY Or _
OFN_FILEMUSTEXIST Or _
OFN_NONETWORKBUTTON Or _
OFN_READONLY Or _
OFN_EXPLORER
Public Type MY_PATHTYPE
    sPath As String
    sDir As String
    sFile As String
    sExt As String
    fCancel As Boolean
End Type

' otwiera okno dialogowe " Otwórz plik: " lub " Zapisz jako: "
' zwraca strukturę MY_PATHTYPE
' po anulowaniu wyboru pliku MY_PATHTYPE.fCancel = True

Public Function zbDlgSaveOpenFile(fSave As Boolean, _
Optional hOwner As Long = 0, _
Optional sTitle As String = "", _
Optional sInitDir As String = "", _
Optional sFilter As String = "", _
Optional lFilterIndex As Long = 0, _
Optional lFlags As Long = 0) As MY_PATHTYPE
On Error GoTo Err_Handler
Dim ofn As OPENFILENAME
Dim pt As MY_PATHTYPE

With ofn
.hwndOwner = hOwner
.hInstance = 0
.lpstrInitialDir = sInitDir

If Len(sTitle) = 0 Then
If fSave Then
.lpstrTitle = MY_TITLE_SAVE
Else
.lpstrTitle = MY_TITLE_OPEN
End If
Else
.lpstrTitle = sTitle
End If

If Len(sFilter) = 0 Then
.lpstrFilter = "Wszystkie (*.*)" & vbNullChar & "*.*" & _
vbNullChar & vbNullChar
Else
.lpstrFilter = sFilter & vbNullChar
End If

If lFlags = 0 Then
If fSave = True Then
.flags = MY_FLAGS_SAVE
Else
.flags = MY_FLAGS_OPEN
End If
Else
.flags = lFlags
End If

.nMaxFile = MY_MAX_LEN
' powiększ buffor dla wyboru wielokrotnego (tylko Otwórz pliki)
If lFlags And OFN_ALLOWMULTISELECT = _
OFN_ALLOWMULTISELECT Then
If fSave = False Then
.nMaxFile = MY_MAX_BUFFER
Else
.flags = MY_FLAGS_SAVE Or _
(.flags And Not OFN_ALLOWMULTISELECT)
End If
End If

.nFilterIndex = lFilterIndex
.lpstrFile = String(.nMaxFile, vbNullChar)
.nMaxFileTitle = MY_MAX_LEN
.lpstrFileTitle = String(.nMaxFileTitle, vbNullChar)

' określ długość zmiennej
.lStructSize = Len(ofn)

If fSave = True Then
pt.fCancel = Not CBool(GetSaveFileName(ofn))
Else
pt.fCancel = Not CBool(GetOpenFileName(ofn))
End If

If pt.fCancel = False Then
' składowe elementy ścieżki:
pt.sPath = Left$(.lpstrFile, _
InStr(.lpstrFile, vbNullChar & vbNullChar) - 1)
pt.sDir = Left$(.lpstrFile, .nFileOffset - 1)
pt.sFile = Left$(.lpstrFileTitle, _
InStr(.lpstrFileTitle, vbNullChar) - 1)

If .nFileExtension > 0 Then
pt.sExt = Right$(pt.sPath, Len(pt.sPath) - .nFileExtension)
End If
End If
End With

zbDlgSaveOpenFile = pt

Err_Exit:
Exit Function
Err_Handler:
MsgBox "Błąd nr " & Err.Number & vbNewLine & _
"Funkcja zbDlgSaveOpenFile" & vbNewLine & _
Err.Description
Resume Err_Exit
End Function


' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim ptRet As MY_PATHTYPE
Dim sFilter As String
Dim arrFiles() As String
Static sCurDir As String
Dim i As Long

' pobierz ścieżkę folderu bazy
If Len(sCurDir) = 0 Then
sCurDir = CurrentDb.Name
sCurDir = Left$(sCurDir, Len(sCurDir) - Len(Dir$(sCurDir)))
End If

sFilter = "Baza danych (*.mdb,*.mde)" & vbNullChar & _
"*.mdb;*.mde" & vbNullChar & _
"Tekstowe (*.txt)" & vbNullChar & "*.txt" & vbNullChar & _
"Wszystkie (*.*)" & vbNullChar & "*.*" & vbNullChar

' okno dialogowe - " Zapisz jako: "
' ptRet = zbDlgSaveOpenFile(True, , , sCurDir, sFilter)

' okno dialogowe - " Otwórz plik: " pliki *.txt z opcją wyboru wielokrotnego
ptRet = zbDlgSaveOpenFile(False, , , sCurDir, sFilter, , _
MY_FLAGS_OPEN Or OFN_ALLOWMULTISELECT)

With ptRet
If .fCancel = False Then
' zapamiętaj katalog
sCurDir = .sDir
' wybór wielokrotny: arrFiles(0) jest katalogiem,
' pozostałe elementy są plikami,

If Len(.sFile) = 0 Then
' Acc2000+
' arrFiles = Split(.sPath, vbNullChar, , vbBinaryCompare)
' Acc'97
zbSplit .sPath, arrFiles(), vbNullChar
Debug.Print i; ". Katalog: "; arrFiles(0)
For i = LBound(arrFiles) + 1 To UBound(arrFiles)
Debug.Print i; ". Pliki: "; arrFiles(i)
Next
Else
ReDim arrFiles(0 To 1)
arrFiles(0) = .sDir
arrFiles(1) = .sFile
Debug.Print 0; ". Katalog: "; arrFiles(0)
Debug.Print 1; ". Plik: "; arrFiles(1)
' szczegółowe informacje o pliku
Debug.Print "Pełna nazwa: " & .sPath & vbNewLine & _
"Katalog: " & .sDir & vbNewLine & _
"Plik: " & .sFile & vbNewLine & _
"Rozszerzenie: " & .sExt
End If
Else
Debug.Print "Anulowano wybór pliku(ów) !"
End If
End With
DoCmd.RunCommand acCmdDebugWindow

End Sub

 ΔΔΔ 

 

5.2 Jak wyświetlić okno dialogoweOtwórz plik " lub " Zapisz plik "
- wersja uproszczona (wybór tylko jednego pliku) ?

Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As Long
    nMaxCustrFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustrData As Long
    lpfnHook As Long
    lpTemplateName As Long
End Type
Private Const OFN_ALLOWMULTISELECT = &H200


' otwiera okno dialogowe " Otwórz plik: " lub " Zapisz jako: " - tylko wybór jednego pliku
' zwraca pełną ścieżkę pliku, po anulowaniu wyboru pliku zwraca ciąg zerowej długości ""

Public Function zbDlgSaveOpenFileBis(fSave As Boolean, _
Optional hOwner As Long = 0, _
Optional sTitle As String = "", _
Optional sInitDir As String = "", _
Optional sFilter As String = "", _
Optional lFilterIndex As Long = 0, _
Optional lFlags As Long = 0) As String
Dim ofn As OPENFILENAME

With ofn
.hwndOwner = hOwner
.hInstance = 0
.lpstrInitialDir = sInitDir

If Len(sTitle) = 0 Then
If fSave Then
.lpstrTitle = " Zapisz jako: "
Else
.lpstrTitle = " Otwórz plik: "
End If
Else
.lpstrTitle = sTitle
End If

If Len(sFilter) = 0 Then
.lpstrFilter = "Wszystkie (*.*)" & vbNullChar & "*.*" & _
vbNullChar & vbNullChar
Else
.lpstrFilter = sFilter & vbNullChar
End If

.nFilterIndex = lFilterIndex
.nMaxFile = 260
.lpstrFile = String(.nMaxFile, vbNullChar)
.nMaxFileTitle = 260
.lpstrFileTitle = String(.nMaxFileTitle, vbNullChar)

If lFlags = 0 Then
If fSave = True Then
.flags = &HA080F
Else
.flags = &HA180D
End If
Else
.flags = lFlags
End If

' nie pozwól na wybór wielokrotny
If (lFlags And OFN_ALLOWMULTISELECT) = _
OFN_ALLOWMULTISELECT Then
.flags = .flags And (Not OFN_ALLOWMULTISELECT)
End If

' określ długość zmiennej
.lStructSize = Len(ofn)

If fSave = True Then
GetSaveFileName ofn
Else
GetOpenFileName ofn
End If

zbDlgSaveOpenFileBis = Left$(.lpstrFile, _
InStr(.lpstrFile, vbNullChar) - 1)

End With

End Function


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

sFilter = "Baza danych (*.mdb,*.mde)" & vbNullChar & _
"*.mdb;*.mde" & vbNullChar & _
"Tekstowe (*.txt)" & vbNullChar & "*.txt" & vbNullChar & _
"Wszystkie (*.*)" & vbNullChar & "*.*" & vbNullChar

' okno dialogowe - " Zapisz jako: ""
sRet = zbDlgSaveOpenFileBis(True, , , "C:\", sFilter)
' okno dialogowe - " Otwórz plik: "
' sRet = zbDlgSaveOpenFileBis(False, , , "C:\", sFilter)

If Len(sRet) = 0 Then
MsgBox "Anulowano"
Else
MsgBox sRet
End If

End Sub

 ΔΔΔ 

 

5.3 Jak wyświetlić okno dialogowe "Wybierz kolor" ?

Private Declare Function ChooseColor Lib "comdlg32.dll" _
Alias "ChooseColorA" _
(pChoosecolor As CHOSECOLOR_TYPE) As Long
Private Type CHOSECOLOR_TYPE
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
Private Const CC_RGBINIT = &H1
Private Const CC_FULLOPEN = &H2


' zwraca kolor wybrany przez użytkownika, jeżeli użytkownik nacisnął przycik Anuluj lub zamknął okno "X"-em - zwraca lDefColor, a zwracana ByRef zmienna lRetCancel = 0,
Private Function zbChooseColor(lRetCancel As Long, _
Optional lDefColor As Long = 0) As Long
Dim cc As CHOSECOLOR_TYPE

With cc
.lStructSize = Len(cc)
.flags = CC_FULLOPEN Or CC_RGBINIT
' zainicjuj kolory niestandardowe jako szare
.lpCustColors = String(16 * 4, 192)
.rgbResult = lDefColor
lRetCancel = ChooseColor(cc)
zbChooseColor = .rgbResult
End With

End Function


' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim lRetCanceled As Long
Dim lColor As Long

' UWAGA: po anulowaniu, funkcja ChooseColor zwraca domyślny kolor (tutaj vbRed), lub 0 (vbBlack) jeżeli nie był inicjowany kolor domyślny, jeżeli użytkownik anulował wybór koloru, wartość zmiennej ByRef lRetCanceled = 0
lColor = zbChooseColor(lRetCanceled, vbRed)

If lRetCanceled = 0 Then
MsgBox "Anulowano"
Else
MsgBox "Wybrano kolor: " & lColor
End If

End Sub

 ΔΔΔ 

 

5.4 Jak wyświetlić okno dialogowe "Wybierz folder" i pobrać nazwę pliku ?

Private Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Type BROWSEINFO
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type

Private Const CSIDL_DESKTOP = &H0
Private Const CSIDL_FAVORITES = &H6

Private Const SHGFP_TYPE_CURRENT = &H0
Private Const SHGFP_TYPE_DEFAULT = &H1

Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_STATUSTEXT = &H4
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_EDITBOX = &H10
Private Const BIF_VALIDATE = &H20
Private Const BIF_BROWSEFORCOMPUTER = &H1000
Private Const BIF_BROWSEFORPRINTER = &H2000
Private Const BIF_BROWSEINCLUDEFILES = &H4000
Private Const MY_MAX_LEN As Long = 260


' zwraca ścieżkę wybranego folderu (pliku), przy błędzie lub anulowaniu wyboru, zwraca ciąg zerowej długości,
Private Function zbBrowseFolder(lCSIDL As Long, _
sDialogTitle As String, _
lFlags As Long) As String
Dim lpIDList As Long
Dim sBff As String
Dim bi As BROWSEINFO

With bi
.pIDLRoot = lCSIDL
.hWndOwner = Me.hwnd
.lpszTitle = sDialogTitle
.ulFlags = lFlags
End With

lpIDList = SHBrowseForFolder(bi)

If (lpIDList) Then
sBff = String(MY_MAX_LEN, vbNullChar)
SHGetPathFromIDList lpIDList, sBff
zbBrowseFolder = Left$(sBff, InStr(sBff, vbNullChar) - 1)
End If

End Function


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

sRet = zbBrowseFolder(CSIDL_FAVORITES, _
"Pokaż z plikami:", _
BIF_BROWSEINCLUDEFILES)
' sRet = zbBrowseFolder(CSIDL_DESKTOP, _
"Pokaż bez plików:", _
BIF_RETURNONLYFSDIRS)


If Len(sRet) = 0 Then
MsgBox "Anulowano"
Else
MsgBox "Wybrano: " & sRet
End If

End Sub

 ΔΔΔ