Public Function bmpIsArrayDIB(bBmpArray() As Byte, _
                    Optional fCheckStorageFormat As Boolean = True) As Boolean
Dim bih             As BITMAPINFOHEADER
Dim lOffsetToBih    As Long
Dim iDim            As Integer
Dim lStorageFormat  As Long
Const cProcName     As String = "Funkcja bmpIsArrayDIB(...)"

	'sprawdź, czy tablica jest zainicjowana i jednowymiarowa
	iDim = vbaIsArrayAllocated(bBmpArray)

	Select Case iDim
		Case 0
			Err.Raise errArrayNotInitialized, cProcName, _
								errBmpDescription(errArrayNotInitialized)
		Case Is <> 1
			Err.Raise errBihOneDimension, cProcName, _
								errBmpDescription(errBihOneDimension)
	End Select

	If fCheckStorageFormat = True Then
		' pobierz 'Format przechowywania właściwości obrazów'
		lStorageFormat = bmpPictureStorageFormat
	Else
		' sprawdź, czy tablica zaczyna się sygnaturą 'BM'
		If Chr$(bBmpArray(0)) & Chr$(bBmpArray(1)) = cBmpSignatureBM Then
			' tablica zawiera 14 bajtowy nagłówek BitmapFileFeader
			' opcja: 'Zachowaj format obrazu źródłowego' MS Access 2007+
			lStorageFormat = cPrpStoragePreserve
		Else
			' tablica nie zawiera sygnatury 'BM', zaczyna się od
			' 40 bajtowego nagłówka BitmapInfoHeader
			' opcja: 'Konwertuj wszystkie dane obrazu na mapy bitowe
			' zgodnie z programem Access 2003 i wcześniejszymi wersjami
			lStorageFormat = cPrpStorageConvert
		End If
	End If

	' sprawdź poprawność tablicy zgodnie z ustawioną wartością lStorageFormat
	Select Case lStorageFormat
		' opcja: 'Zachowaj format obrazu źródłowego' MS Access 2007+
		Case cPrpStoragePreserve
			' tablica musi zawierać 14 bajtowy nagłówek
			' BitmapFileFeader wraz z sygnaturą 'BM'
			If Chr$(bBmpArray(0)) & Chr$(bBmpArray(1)) = cBmpSignatureBM Then
				' ustaw offset do Nagłówka BitmapInfoHeader
				lOffsetToBih = cBmpBfhSize
			Else
				Err.Raise errBmpFailSignature, cProcName, _
									errBmpDescription(errBmpFailSignature)
			End If
			' przekazana tablica musi zawierać minimum 54 bajty (14+40+4)
			If UBound(bBmpArray) < (cBmpMinSize - 1) Then
				Err.Raise errBmpTooSmall, cProcName, _
									errBmpDescription(errBmpTooSmall)
			End If
		' opcja: 'Konwertuj wszystkie dane obrazu na mapy bitowe
		' zgodnie z programem Access 2003 i wcześniejszymi wersjami
		Case cPrpStorageConvert, cPrpStorageNotFound
			' ustaw offset do Nagłówka BitmapInfoHeader
			lOffsetToBih = 0
			' przekazana tablica musi zawierać minimum 44 bajty (40+4)
			If UBound(bBmpArray) < (cBmpMinSize - cBmpBfhSize - 1) Then
				Err.Raise errBmpDibTooSmall, cProcName, _
									errBmpDescription(errBmpDibTooSmall)
			End If
		Case Else
			Err.Raise errOthUnexpected, cProcName, _
								errBmpDescription(errOthUnexpected)
	End Select

	'kopiuj bajty bitmapy do struktury BitmapInfoHeader
	CopyMemory bih, bBmpArray(lOffsetToBih), ByVal cBmpBihSize

	'sprawdź, czy nagłówek bitmapy jest 40-bajtowy
	If bih.biSize <> cBmpBihSize Then
		Err.Raise errBihFailSize, cProcName, _
							errBmpDescription(errBihFailSize)
	End If

	'sprawdź głębię kolorów
	If bih.biBitCount <> cBmpBitCount24 Then
		Err.Raise errBmpOnlyBitCount24, cProcName, _
								 errBmpDescription(errBmpOnlyBitCount24)
	End If
		
	'sprawdź, czy bitmapa jest nieskompresowana
	If bih.biCompression <> cBmpNotCompressed Then
		Err.Raise errBmpIsCompressed, cProcName, _
							errBmpDescription(errBmpIsCompressed)
	End If

	'sprawdź, czy bitmapa jest "z dołu do góry"
	If bih.biHeight < 0 Then
		Err.Raise errBmpIsTopDown, cProcName, _
							errBmpDescription(errBmpIsTopDown)
	End If

	bmpIsArrayDIB = True

End Function

Option Compare Database
Option Explicit

' 14 bajtowy nagłówek pliku bitmapy.
' Zawiera informacje o rodzaju, rozmiarze i układzie pliku bitmapy (DIB).
Public Type BITMAPFILEHEADER
	bfType As Integer            'sygnatura BM (0x4D42) hex. &H424D
	bfSize As Long               'całkowity rozmiar pliku w bajtach
	bfReserved1 As Integer       'zarezerwowany - zazwyczaj równy ZERO
	bfReserved2 As Integer       'zarezerwowany - zazwyczaj równy ZERO
	bfOffBits As Long            'przesunięcie (w bajtach) do bajtów obrazu bitmapy
End Type
  
' 40 bajtowy nagłówek informacyjny bitmapy.
' Zawiera dane o właściwości bitmapy i organizacja jej kolorów.
Public Type BITMAPINFOHEADER
	biSize As Long                'rozmiar struktury
	biWidth As Long               'szerokość mapy bitowej w pikselach
	biHeight As Long              'wysokość mapy bitowej w pikselach. Dla dodatniej wartość biHeight,
																'bitmapa jest typu „z dołu do góry” i jej punkt początkowy
																'znajduje się w lewym dolnym rogu. Dla ujemnych biHeight
																'bitmapa jest typu „z góry na dół” i jej początek
																'znajduje się w lewym górnym rogu.
	biPlanes As Integer           'liczba warstw koloru, zawsze = 1
	biBitCount As Integer         'liczba bitów koloru na jeden piksel (1,4,8,16,24,32)
	biCompression As Long         'typ kompresji: BI_RGB = 0 (bez kompresji), BI_RLE8, BI_RLE4,
																'BI_BITFIELDS, BI_JPEG, BI_PNG
	biSizeImage As Long           'wielkość mapy bitowej w bajtach, jeżeli bitmapa jest
																'nieskompresowana (element biCompression równy jest BI_RGB)
																'wartość biSizeImage może być ustawiona na ZERO
	biXPelsPerMeter As Long       'rozdzielczość pozioma pixel/metr - zazwyczaj ZERO,
																'wartość 2835 odpowiada rozdzielczości 72 dpi,
																'wartość 11811 odpowiada rozdzielczości 300 dpi
	biYPelsPerMeter As Long       'rozdzielczość pionowa pixel/metr - opis jw.
	biClrUsed As Long             'liczba użytych kolorów (liczba pozycji w tablicy kolorów),
																'dla biClrUsed=0 używana jest maksymalna ilość kolorów
																'określona przez wartości pola biBitCount
	biClrImportant As Long        'liczba kolorów znaczących, zazwyczaj ZERO tzn. że wszystkie
																'kolory są potrzebne do wyświetlenia bitmapy
	'biClrUsed - dla 1-bitowych DIB = 0 lub 2
	'biClrUsed - dla 4-bitowych DIB = 0 lub 16, jeżeli 2-15 to wskazuje liczbę pozycji
							'w tablicy kolorów
	'biClrUsed - dla 8-bitowych DIB = 0 lub 256, jeżeli 2-255 to wskazuje liczbę pozycji
							'w tablicy kolorów
	'biClrUsed - dla 16, 24, 32 bitowych DIB zwykle wynosi ZERO
End Type

Option Compare Database
Option Explicit

Public Const cAccVersion2007   As Long = 12          'numer wersji MS Access 2007
'+-----------------------------------------------+
'|              Const - Bitmap                   |
'+-----------------------------------------------+
Public Const cBmpIntSignature  As Integer = &H4D42   'sygnatura bitmapy "BM" jako liczba Integer
Public Const cBmpSignatureBM   As String = "BM"      'sygnatura bitmapy "BM" jako ciąg znaków
Public Const cBmpBfhSize       As Long = 14          'wielkość nagłówka BitmaFileHeader
Public Const cBmpBihSize       As Long = 40          'wielkość nagłówka BitmapInfoHeader
Public Const cBmpOffsetToBits  As Long = 54          'przesunięcie do bajtów obrazu bitmapy
Public Const cBmpBitCount24    As Long = 24          'głębia kolorów - bitów na piksel
Public Const cBmpBitCount32    As Long = 32          'głębia kolorów - bitów na piksel
Public Const cBmpNotCompressed As Long = 0           'nieskompresowana bitmapa BI_RGB = 0&
Public Const cBmpMinSize       As Long = 58          'minimalny rozmiar bitmapy 24bit (14+40+4)
Public Const cBmpDIBMinSize    As Long = 44          'minimalny rozmiar DIB bitmapy 24bit (40+4)

Option Compare Database
Option Explicit
'+---------------------------------------------+
'| Errors - własna obsługa niektórych błędów   |
'+---------------------------------------------+
'inny, nieprzewidziany błąd
Public Const errOthUnexpected       As Long = vbObjectError + 1
'-----------------------------------------------------------------
'dolna granica zakresu numerów błędów dotyczących plików
Private Const errFileError          As Long = vbObjectError + 100
'nazwa pliku zawiera nieprawidłowe znaki
Public Const errFileBadName         As Long = errFileError + 1
'plik istnieje na dysku
Public Const errFileExist           As Long = errFileError + 3
'plik nie istnieje na dysku
Public Const errFileNotExist        As Long = errFileError + 4
'--------------------------------------------------------------------
'dolna granica zakresu numerów błędów dotyczących argumentów funkcji
Private Const errArgsError          As Long = vbObjectError + 200
'argument musi być tablicą
Public Const errArgIsNotArray       As Long = errArgsError + 1
'tablica jest niezainicjowana
Public Const errArrayNotInitialized As Long = errArgsError + 2
'nieprawidłowa wartość argumentu
Public Const errArgFailValue        As Long = errArgsError + 3
'--------------------------------------------------------------------
'dolna granica zakresu numerów błędów dotyczących bitmap
Private Const errBmpError           As Long = vbObjectError + 300
'błąd formatu pliku (nieprawidłowa sygnatura pliku)
Public Const errBmpFailSignature    As Long = errBmpError + 1
'błąd formatu nagłówka BitmapInfoHeader
Public Const errBihFailFormat       As Long = errBmpError + 2
'błąd formatu nagłówka BitmapInfoHeader
Public Const errBihFailSize         As Long = errBmpError + 3
'brak nagłówka BitmapInfoHeader
Public Const errBihNotExist         As Long = errBmpError + 4
'nagłówek musi być tablicą jednowymiarową
Public Const errBihOneDimension     As Long = errBmpError + 5
'obsługiwana jest tylko 24 i 32-bitowa głębia kolorów
Public Const errBmpBitCount         As Long = errBmpError + 6
'obsługiwana jest tylko 24 głębia kolorów
Public Const errBmpOnlyBitCount24   As Long = errBmpError + 7
'obsługiwana jest tylko 24 głębia kolorów
Public Const errBmpIsCompressed     As Long = errBmpError + 8
'obsługiwana jest tylko bitmapa z 'dołu do góry'
Public Const errBmpIsTopDown        As Long = errBmpError + 9
'Plik bitmapy jest zbyt mały (min. 58 bajtów)
Public Const errBmpTooSmall         As Long = errBmpError + 10
'PictureData: DIB jest zbyt mały (min. 44 bajty)
Public Const errBmpDibTooSmall      As Long = errBmpError + 11

'--------------------------------------------------------------------
'dolna granica zakresu numerów błędów dotyczących Właściwości
Private Const errPrpError           As Long = vbObjectError + 1000
'nie można ustawić właściwości „Picture Property Storage Format”
'(Format przechowywania właściwości obrazów)
Public Const errPropertyStorage     As Long = errPrpError + 1
'nieoczekiwany błąd ustawienia właściwości Format przechowywania
'właściwości obrazów (Picture Property Storage Format)"
Public Const errPropertyStorageFail As Long = errPrpError + 2


' zwraca opis błędu własnego o numerze lErrNo
Public Function errBmpDescription(lErrNo As Long) As String
Dim sErrDscr As String

	Select Case lErrNo
	'------------------------- errFileError = vbObjectError + 100
	Case errFileBadName
		sErrDscr = "Pełna nazwa pliku zawiera nieprawidłowy znak"
	Case errFileExist
		sErrDscr = "Plik docelowy istnieje."
	Case errFileNotExist
		sErrDscr = "Plik nie istnieje na dysku."
	'------------------------- errArgsError = vbObjectError + 200
	Case errArgIsNotArray
		 sErrDscr = "Argumentem funkcji musi być tablicą."
	Case errArrayNotInitialized
		 sErrDscr = "Tablica nie jest zainicjowana."
	Case errArgFailValue
		 sErrDscr = "Nieprawidłowa wartość argumentu."
	'------------------------- errBmpError = vbObjectError + 300
		Case errBmpFailSignature
			sErrDscr = "Niewłaściwa sygnatura pliku bitmapy."
		Case errBihFailFormat
			sErrDscr = "Błąd formatu nagłówka BitmapInfoHeader"
		Case errBihFailSize
			sErrDscr = "Nagłówek BitmapInfoHeader musi mieć wielkość 40 bajtów"""
		Case errBihNotExist
			sErrDscr = "Niezainicjowany nagłówek BitmapInfoHeader bitmapy."
		Case errBihOneDimension
			sErrDscr = "Nagłówek BitmapInfoHeader " & _
								 "musi być tablicą jednowymiarową."
		Case errBmpBitCount
			sErrDscr = "Obsługiwana jest tylko bitmapa" & vbNewLine & _
								 "o 24 lub 32-bitowej głębi kolorów."
		Case errBmpOnlyBitCount24
			sErrDscr = "Obsługiwana jest tylko bitmapa" & vbNewLine & _
								 "o 24-bitowej głębi kolorów."
		Case errBmpIsCompressed
			sErrDscr = "Bitmapa skompresowana nie jest obsługiwana."
		Case errBmpIsTopDown
			sErrDscr = "obsługiwana jest tylko bitmapa z 'dołu do góry'."
		Case errBmpTooSmall
			sErrDscr = "Plik bitmapy jest zbyt mały." & vbNewLine & _
								 "Minimalna wielkość to " & cBmpMinSize & " bajtów."
		Case errBmpDibTooSmall
			sErrDscr = "Tablica Image.PictureData" & vbNewLine & _
								 "musi zawierać minimum " & cBmpDIBMinSize & " bajtów."
		Case Else
			sErrDscr = "Nieprzewidziany błąd Aplikacji." & vbNewLine & _
								 "Zanotuj nr błędu i opis" & vbNewLine & _
								 "i skontaktuj się z Administratorem."
	End Select

	errBmpDescription = sErrDscr

End Function

' Funkcja vbaIsArrayAllocated(...) pobiera wskaźnik lptrArray do przekazanej w argumencie
' vArray zmiennej i wczytuje do zmiennej vt dwa pierwsze bajty z deskryptora zmiennej Variant.
' W zmiennej vt flaga VT_ARRAY musi być ustawiona, gdyż argument vArray ma wskazywać na tablicę.
' W przeciwnym wypadku funkcja kończy działanie. Następnie pobierany jest wskaźnik lptrSA
' do struktury SAFEARRAY. Jeżeli w zmiennej vt flaga VT_BYREF jest ustawiona, to lptrSA jest
' wskaźnikiem do wskaźnika do struktury SAFEARRAY, co wymusza ponowne pobranie nowego wskaźnika.
' Jeżeli nowy wskaźnik lptrSA jest równy ZERO, to tablica nie jest zainicjowana.
' Dla wartości  wskaźnika lptrSA większej od Zera pobierany jest ze struktury SAFEARRAY
' element iDims określający ilość wymiarów tablicy. Wartość elementu iDims większa od Zera
' nie wskazuje jednoznacznie, że tablica została zainicjowana.
' Przypadek ten dotyczy zmiennej Variant zawierającej niezainicjowaną tablicę vArray = Array().
' Dopiero ilość elementów cElements struktury SAFEARRAYBOUND z ostatniego elementu
' tablicy rgsabound() będącej elementem struktury SAFEARRAY równa ZERO jednoznacznie określa,
' że tablica nie jest zainicjowana.
'   argumenty:
'     vArray
'       zmienna typu Variant zawierającą tablicę.
'   zwraca:
'     Jeżeli przekazana w argumencie tablica jest zainicjowana zwraca ilość wymiarów tablicy.
'     Jeżeli tablica nie jest zainicjowana zwraca ZERO.
' autor: Zbigniew Bratko
' data: 03.02.2019
'

Option Compare Database
Option Explicit
#If VBA7 Then
  Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
        Alias "RtlMoveMemory" ( _
        Destination As Any, _
        source As Any, _
        ByVal Length As LongPtr)
#Else
  Private Declare Sub CopyMemory Lib "kernel32" _
        Alias "RtlMoveMemory" _
        (Destination As Any, _
        Source As Any, _
        ByVal Length As Long)
#End If

Public Function vbaIsArrayAllocated(ByRef vArray As Variant) As Long
Dim vt            As Integer      ' kombinacja stałych (VT_) określająca typ danych
Dim iDims         As Integer      ' ilość wymiarów tablicy
Dim lElements     As Long         ' ilość elementów w wymiarze tablicy
Dim lLbound       As Long         ' dolny indeks wymiaru
Dim i             As Long
Const VT_BYREF = &H4000&          ' flaga - wskaźnik przekazany przez wskaźnik
Const VT_ARRAY = &H2000&          ' flaga = vbArray - tablica
Const conLenVarDscr As Long = 8   ' wielkość deskryptora zmiennej Variant
   
#If VBA7 Then
  Dim lptrSA        As LongPtr    ' wskaźnik do struktury SAFEARRAY
  Dim lptrArray     As LongPtr    ' wskaźnik do zmiennej vArray
  Const conLengthSA As Long = 24  ' offset do tablicy rgsabound[1]
#Else
  Dim lptrSA        As Long       ' wskaźnik do struktury SAFEARRAY
  Dim lptrArray     As Long       ' wskaźnik do wskaźnik do zmiennej vArray
  Const conLengthSA As Long = 16  ' offset do tablicy rgsabound[1]
#End If

	' pobierz wskaźnik to zmiennej vArray
	lptrArray = VarPtr(vArray)

	'pobierz VarType z deskryptora zmiennej Variant (dwa pierwsze bajty)
	CopyMemory vt, ByVal lptrArray, ByVal 2

	' jeżeli zmienna vArray nie jest tablicą => wyjdź
	If (vt And VT_ARRAY) <> VT_ARRAY Then Exit Function

	'pobierz wskaźnik lptrSA do struktury SAFEARRAY
	CopyMemory lptrSA, ByVal lptrArray + conLenVarDscr, ByVal LenB(lptrArray)

	'tablica jest niezainicjowana => wyjdź
	If lptrSA = 0 Then Exit Function

	' sprawdź, czy lptrSA jest wskaźnikiem do struktury SAFEARRAY,
	' czy wskaźnikiem do wskaźnika do struktury SAFEARRAY
	If (vt And VT_BYREF) = VT_BYREF Then
		'pobierz wskaźnik do struktury SAFEARRAY
		CopyMemory lptrSA, ByVal lptrSA, ByVal LenB(lptrSA)
	End If

	'tablica jest niezainicjowana => wyjdź
	If lptrSA = 0 Then Exit Function

	'pobierz ilość wymiarów tablicy
	CopyMemory iDims, ByVal lptrSA, ByVal 2

	'tablica nie jest zainicjowana
	If iDims <= 0 Then Exit Function

	' lptrSA > 0 i intDims > 0 ;Sprawdź ostatecznie, czy tablica
	' jest zainicjowana: przypadek: vArray = Array()
	CopyMemory lElements, ByVal (lptrSA + conLengthSA), ByVal 4

	' jeżeli brak elementu w ostatnim wymiarze tablicy => wyjdź
	If lElements = 0 Then Exit Function

	vbaIsArrayAllocated = iDims

End Function

' Właściwość „Format przechowywania właściwości obrazów”
'? Public Function bmpPictureStorageFormat( _
'                Optional lPictStorageFormat As Long _
'                         = cPrpStorageNotChange) As Long
' Pobiera numer wersji Ms Access za pomocą funkcji Numer wersji MS Access (...).
' Jeżeli MS Access jest w wersji 2003 lub niższej, funkcja zwraca wartość
' cPrpStorageNotFound = - 1. Chociaż właściwość „Picture Property Storage Format” nie istnieje,
' ale wersje niższe MS Access konwertują pliki graficzne na mapy bitowe zgodne programem
' Access 2003 i wcześniejszymi wersjami, czyli faktycznie zwrócona wartość odpowiada wartości
' stałej cPrpStorageConvert = 1
' Gdy MS Access jest w wersji 2007 i wyższej, funkcja próbuje pobrać właściwość „Format
' przechowywania właściwości obrazów”. Jeżeli właściwość ta istnieje, pobierana jest
' jej wartość. Dla wartości argumentu lPictStorageFormat = 0 lub = 1 ustawia nową wartość
' i równocześnie ją zwraca. Dla wartości argumentu lPictStorageFormat = cPrpStorageNotChange
' zwraca jedynie wartość właściwości.
' Jeżeli właściwość nie istnieje, występuje błąd wykonania nr 3270 o treści "Nie odnaleziono
' właściwości". Dzięki instrukcji On Error Resume Next kontynuowane jest wykonywania
' kodu bez względu na występujące ewentualne błędy. Wygenerowany błąd zostaje przechwycony
' i w zależności od wartości argumentu lPictStorageFormat zostaje utworzona właściwość
' „Picture Property Storage Format” o wartości lPictStorageFormat, która zostaje zwrócona,
 'bądź funkcja zwraca wartość cPrpStorageNotFound = - 1.
'   argumenty:
'     lPictStorageFormat
'       opcjonalny argument określający nową wartość właściwości „Formatu przechowywania
'       właściwości obrazów”. Dla wartości domyślnej cPrpStorageNotChange = - 2 wartość
'       właściwości zostaje tylko pobrana (wartość właściwość nie ulega zmienianie).
'   zwraca:
'     Przy powodzeniu zwraca wartość właściwości „Format przechowywania właściwości obrazów”
'     0 - Zachowaj format obrazu źródłowego (dla wersji MS Access 2007 i wyższe)
'     1 - Konwertuj wszystkie dane obrazu na mapy bitowe (zgodne
'         z programem Access 2003 i wcześniejszymi wersjami)
'    -1 - cPrpStorageNotFound właściwość nie jest ustawiona (obowiązuje opcja = 1
'         „Konwertuj wszystkie dane obrazu na mapy bitowe”).
'    -3 - cPrpStorageUnknown wartość zwracana przy niepowodzeniu.
' autor: Zbigniew Bratko
' data: 04.02.2019 cPrpStorageUnknown
Public Function bmpPictureStorageFormat( _
              Optional lPictStorageFormat As Long _
                       = cPrpStorageNotChange) As Long
Dim dbs            As DAO.Database
Dim prp            As DAO.Property
Dim lStorageFormat As Long
Dim lErrNumber     As Long
Dim strErrDscription  As String
Const cProcName       As String = "Funkcja bmpPictureStorageFormat(...)"


	' ustaw domyślną zwracaną wartość
	bmpPictureStorageFormat = cPrpStorageUnknown

	'sprawdź poprawność argumentu:  < = 1
	If lPictStorageFormat > cPrpStorageConvert Then
		Err.Raise errArgFailValue, cProcName, _
							errBmpDescription(errArgFailValue)
	End If

	'sprawdź wersję MS Access
	If vbaVersionAccess < cAccVersion2007 Then
		'Access jest w wersji 2003 lub niższej, (właściwość nie występuje)
		bmpPictureStorageFormat = cPrpStorageNotFound
		Exit Function
	End If

	Set dbs = CurrentDb
		With dbs
			On Error Resume Next
				' ponieważ właściwość może być nieustawiona, włącz pułapkowanie błędu
				' i spróbuj pobrać format przechowywania obrazów
				lStorageFormat = .Properties(cPrpStoragePictureName)
				If Err.Number = 0 Then
					'właściwość jest ustawiona, zapisz wartość
					bmpPictureStorageFormat = lStorageFormat
					If lPictStorageFormat >= 0 Then
						' ustaw właściwość, jeżeli wartość jest inna niż przekazana
						If lPictStorageFormat  < > lStorageFormat Then
							.Properties(cPrpStoragePictureName) = lPictStorageFormat
							' zwróć wartość właściwości
							bmpPictureStorageFormat = .Properties(cPrpStoragePictureName)
						End If
					End If
				Else
					' właściwość nie jest ustawiona
					If Err.Number = cAccPrpNotFound Then
						' i nie jest wymagana zmiana, zwróć brak
						' właściwości cPrpStorageNotFound = (-1)
						If lPictStorageFormat < 0 Then
							bmpPictureStorageFormat = cPrpStorageNotFound
						Else
							'utwórz właściwość i przypisz jej wartość
							Set prp = .CreateProperty( _
								cPrpStoragePictureName, _
										dbLong, lPictStorageFormat)
										.Properties.Append prp
								.Properties.Refresh
								bmpPictureStorageFormat = .Properties(cPrpStoragePictureName)
							Set prp = Nothing
						End If
					Else
						'nieprzewidziany błąd, włącz obsługę błędów i wygeneruj błąd
						On Error GoTo 0
						Err.Raise Err.Number, cProcName, Err.Description
					End If
				End If
			On Error GoTo 0
		End With
	Set dbs = Nothing

End Function

' ? Public Function vbaVersionAccess() As Integer
' Wykorzystując funkcję SysCmd z argumentem acSysCmdAccessVer pobiera do zmiennej
' typu Variant wersję programu MS Access i konwertuje zwracaną wartość na typ Integer.
'   argumenty:
'     nie pobiera argumentów
'   zwraca:
'     Przy powodzeniu zwraca nr wersji MS Access. Przy niepowodzeniu zwraca ZERO.
' autor: Zbigniew Bratko
' data: 08.02.2019
Public Function vbaVersionAccess() As Integer
Dim varVersion As Variant

	 varVersion = Nz(Application.SysCmd(acSysCmdAccessVer), 0)
	 If IsNumeric(varVersion) Then
			vbaVersionAccess = CInt(varVersion)
	 Else
			vbaVersionAccess = Val(varVersion)
	 End If

End Function