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.5. VBA - Operacje na liczbach [1] •

5.1 Jak zaokrąglić liczbę do n cyfr po przecinku, bo funkcja Round(...) źle działa ?
5.2 Czy zawsze np. (2,3 - 2,3) = 0 ?
5.3 Dlaczego jak przypisuję do zmiennej Long wynik iloczynu (255 * 255) Access zgłasza błąd "Przepełnienia" ?
5.4 Jak pobrać systemowy separator dziesiętny ?
5.5 Jak obliczyć silnię liczby (max. 27) oraz jak obliczyć liczbę, której silnią jest liczba X ?
5.6 Jak pobrać ze zmiennej typu Long młodsze i starsze słowo oraz młodszy i starszy bajt z każdego słowa ?
5.7 Jak przekonwertować liczbę do postaci Hexadecymalnej i odwrotnie ?
5.8 Jak przypisać do zmiennej Variant (podtyp Decimal) liczbe przekraczajacą zakres
typu Long np. 10888869450418352160768000000 ?
5.9 Jak pobrać ilość dni w miesiącu dla danego roku ?
<<• idź do str. 2 •>>
 

5.1 Jak zaokrąglić liczbę do n cyfr po przecinku, bo funkcja Round(...) źle działa ?

' wykonajmy mały test funkcja Round (...) :
Private Sub btnTest_Click()

Debug.Print "Round"
Debug.Print 1.015, Round(1.015, 2) ' zwraca 1.01
Debug.Print 1.025, Round(1.025, 2) ' zwraca 1.02
Debug.Print 1.075, Round(1.075, 2) ' zwraca 1.08
Debug.Print 1.085, Round(1.085, 2) ' zwraca 1.08
    ' Jak widać funkcja Round(...) nie zwraca takich wartości jakie byśmy oczekiwali.
    ' No cóż, trudno... , zawsze możesz spróbowac użyć funkcji Błażeja,
    ' lub zajrzeć na http://www.access.vis.pl/af0808.htm - Function Zaokr2(...)

Call btnTest1_Click
DoCmd.RunCommand acCmdDebugWindow

End Sub


Private Sub btnTest1_Click()

Debug.Print "bs_Round"
Debug.Print 1.015, bs_Round(1.015, 2) ' zwraca 1.02
Debug.Print 1.025, bs_Round(1.025, 2) ' zwraca 1.03
Debug.Print 1.075, bs_Round(1.075, 2) ' zwraca 1.08
Debug.Print 1.085, bs_Round(1.085, 2) ' zwraca 1.09

End Sub


grupa: pl.comp.bazy-danych.msaccess
wątek: Funkcja Round raz jeszcze
przedstawił: Błażej Strus

<cyt>
Public Function bs_Round(Number As Variant, _
NumDigitsAfterDecimal As Long) As Double

If Not IsNumeric(Number) Then Err.Raise 5
bs_Round = Sgn(Number) * Int(CDec(Abs(Number)) * _
(10 ^ NumDigitsAfterDecimal) + 0.5) / _
(10 ^ NumDigitsAfterDecimal)

End Function
</cyt>

 ΔΔΔ 

 

5.2 Czy zawsze np. (2,3 - 2,3) = 0 ?

' I tak, i nie. Zobacz sam ;-)
Private Sub btnTest_Click()

Debug.Print "1. = "; 2.3 - (23 / 10)
Debug.Print "2. = "; CSng(2.3) - (23 / 10)
Debug.Print "3. = "; (2.3) - CSng(23 / 10)
Debug.Print "4. = "; CSng(2.3) - CSng(23 / 10)
Debug.Print "5. = "; (2.3) - CDbl(23 / 10)
Debug.Print "6. = "; CDbl(2.3) - CDbl(23 / 10)
Debug.Print "7. = "; (2.3) - CDec(23 / 10)

DoCmd.RunCommand acCmdDebugWindow

End Sub

Podobny problem został poruszony:

grupa: pl.comp.bazy-danych.msaccess
wątek: Zły wynik mnożenia
autor: Nguyen Bang Giang


 ΔΔΔ 

 

5.3 Dlaczego jak przypisuję do zmiennej Long wynik iloczynu (255 * 255) Access zgłasza błąd "Przepełnienia" ?

Private Sub btnTest_Click()
Dim lRet As Long

On Error Resume Next
' wystąpi błąd przepełnienia
lRet = 255 * 255
Debug.Print lRet;
If Err.Number <> 0 Then Debug.Print "- "; Err.Description
On Error GoTo 0

' nie będzie błędu
lRet = CLng(255) * 255
Debug.Print lRet
Debug.Print "====================="

    ' dzieje się tak ponieważ domyślnym typem liczby jest typ Integer. Błąd przepełnienia wystąpi również, gdy zadeklarujemy zmienną jako Byte i pomnożymy ją przez siebie, a wynik będzie przekraczał zakres typu Byte:

Dim b As Byte
b = 16
lRet = 0 ' czyścimy zmienną
On Error Resume Next
' wystąpi błąd przepełnienia
lRet = b * b
Debug.Print lRet;
If Err.Number <> 0 Then Debug.Print "- "; Err.Description
On Error GoTo 0

' nie będzie błędu
lRet = CInt(b) * b
Debug.Print lRet

DoCmd.RunCommand acCmdDebugWindow

End Sub

 ΔΔΔ 

 

5.4 Jaki pobrać systemowy separator dziesiętny ?

grupa: pl.comp.lang.vbasic
w oparciu o wątek: Kropka, przecinek i IsNumeric



Private Declare Function GetLocaleInfo Lib "kernel32" _
Alias "GetLocaleInfoA" _
(ByVal Locale As Long, _
ByVal LCType As Long, _
ByVal lpLCData As String, _
ByVal cchData As Long) As Long
Private Const LOCALE_USER_DEFAULT = &H400
Private Const LOCALE_SDECIMAL = &HE


' Metoda I - sestemowy separator dziesiętny pobierzemy używając funkcji API
Private Function zbGetDecSep1() As String
Dim lRet As Long
Dim sBffInfo As String
Const MY_SIZEBUFFER As Long = 255

sBffInfo = String(cSizeBff, vbNullChar)
lRet = GetLocaleInfo(LOCALE_USER_DEFAULT, _
LOCALE_SDECIMAL, _
sBffInfo, MY_SIZEBUFFER)
zbGetDecSep1 = Left$(sBffInfo, lRet - 1)
' • jeżeli użytkownik ustawił w Panelu sterowania separator dziesiętny w postaci kilku znaków (w Win98 możliwe jest wstawienie trzech znaków) to funkcja ta zwróci nam błędny wynik w postaci ciągu wpisanych znaków,
' • wielkość bufora jest zdecydowanie za duża, teoretycznie powinna wystarczyć wartość 3 (max. trzy znaki), a vbNullChar doda sam VBA, ale dla mniejszych wartości funkcja GetLocaleInfo(...) może zwrócić ZERO

End Function

' pobierzmy więc tylko pierwszy znak zwracanego ciągu separatora dziesiętnego
Private Function zbGetDecSep2() As String
Dim lRet As Long
Const MY_SIZEBUFFER As Long = 255

zbGetDecSep2 = vbNullChar
lRet = GetLocaleInfo(LOCALE_USER_DEFAULT, _
LOCALE_SDECIMAL, _
zbGetDecSep2, _
MY_SIZEBUFFER)
If lRet = 0 Then zbGetDecSep2 = ""

End Function


' Metoda II - pl.comp.bazy-danych.msaccess - Piotr Lipski
' separator dziesiętny jest drugim znakiem w ilorazie 1/2 = 0,5)

Private Function accGetDecSep() As String
accGetDecSep = Mid$(CStr((1 / 2)), 2, 1)
End Function


' przykładowe wywołanie:
Private Sub btnTest_Click()
Debug.Print "1. zbGetDecSep1 = ", zbGetDecSep1
Debug.Print "2. zbGetDecSep2 = ", zbGetDecSep2
Debug.Print "3. accGetDecSep = ", accGetDecSep

DoCmd.RunCommand acCmdDebugWindow

End Sub

 ΔΔΔ 

 

5.5 Jak obliczyć silnię liczby (max. 27) oraz jak obliczyć liczbę, której silnią jest liczba X ?

grupa: pl.comp.bazy-danych.msaccess
wątek: Funkcja "odwrotna" do silni Opcje
w oparciu o artykuł: Krzysztofa Naworyty



Private Const ERR_ARG_SILNIA = vbObjectError + 100
Private Const ERR_ARG_ANTYSILNIA = vbObjectError + 101


' dla i = 0 zwraca 1, przy błędnej wartości zwraca -1
' przy przekroczniu zakresu i > 27 generuje błąd

Function knSilnia(i As Byte) As Variant

knSilnia = -1
If i > 27 Then
Err.Raise ERR_ARG_SILNIA, "knSilnia", _
"Wartość argumentu funkcji knSilnia(...)" & _
vbNewLine & "nie może być większa od 27"
End If

If i <2 Then
knSilnia = 1
Else
knSilnia = CDec(knSilnia(i - 1) * i)
End If

End Function

'<KN>
' działa do 27!
' powyżej tej liczby dzielenie musisz robić samodzielnie,
' tak jak Cię uczono w szkole, słupkowo
'</KN>



' dla k = 0; k = 1 zwraca 1, przy błędnej wartości zwraca -1
' przy przekroczniu dopuszczlnego zakresu generuje błąd,

Function knAntySilnia(ByVal k As Variant) As Variant
Dim i As Integer

knAntySilnia = -1
If k - CDec("10888869450418352160768000000") > 0 Then
Err.Raise ERR_ARG_ANTYSILNIA, "knSAntyilnia", _
"Wartość argumentu funkcji knAntySilnia(...)" & _
vbNewLine & "nie może być większa od:" & _
vbNewLine & _
"10888869450418352160768000000"
End If

If k = 0 Or k = 1 Then
knAntySilnia = 1
Exit Function
End If

Do Until k = 1
i = i + 1
k = k / i
If k - Int(k) > 0 Then Exit Function
Loop

knAntySilnia = i

End Function


przykładowe wywołanie:
Private Sub btnTest_Click()
On Error GoTo ErrHandler
Dim i As Byte
Dim lRet As Variant

For i = 0 To 27
lRet = knSilnia(i)
Debug.Print i; lRet;
Debug.Print knAntySilnia(lRet + 1)
Next
DoCmd.RunCommand acCmdDebugWindow

ExitHere:
    Exit Sub
ErrHandler:
    MsgBox "Błąd nr: " & Err.Number & vbNewLine & _
        Err.Description
    Resume ExitHere
End Sub

 ΔΔΔ 

 

5.6 Jak pobrać ze zmiennej typu Long młodsze i starsze słowo oraz młodszy
i starszy bajt z każdego słowa ?

' Metoda I - opisana w MSDN,
' Tip 22: Converting DWords, Words, and Bytes
' Artykuły w Bazie Wiedzy Microsoft - 189170
' How To Package HiWord / LoWord Values Into a Long Parameter
' Artykuły w Bazie Wiedzy Microsoft - 112651
' How to Mimic HIWORD, LOWORD, HIBYTE, LOBYTE C Macros in VB

z poprawkami: Krzysztofa Naworyty
grupa: pl.comp.lang.vbasic
wątek: HiWord LoWord



Private Function MakeDWord( _
ByVal iHiWord As Integer, _
ByVal iLoWord As Integer) As Long
MakeDWord = (iHiWord * &H10000) Or (iLoWord And &HFFFF)
End Function


Private Function MakeWord( _
ByVal bHiByte As Byte, _
ByVal bLoByte As Byte) As Integer
'<KN>
If bHiByte < &H80 Then
MakeWord = (bHiByte * &H100) Or bLoByte
Else
MakeWord = (bHiByte Or &HFF00) * &H100& Or bLoByte
End If
'</KN>
End Function


Private Function HiWord(ByVal DWord As Long) As Integer
HiWord = (DWord And &HFFFF0000) \ &H10000
End Function


Private Function LoWord(ByVal DWord As Long) As Integer
If DWord And &H8000& Then
LoWord = DWord Or &HFFFF0000
Else
LoWord = DWord And &HFFFF&
End If
End Function


Private Function HiByte(ByVal Word As Integer) As Byte
'<KN>
HiByte = (Word And &HFF00&) \ &H100&
'</KN>
End Function


Private Function LoByte(ByVal Word As Integer) As Byte
LoByte = Word And &HFF
End Function


' Metoda II - z użyciem funkcji CopyMemory (...)
' jest ok. 2x szybsza od metody MSDN i moim zdaniem bardziej
' uniwersalna, aczkolwiek wymagająca deklarowania tablic,

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)

Private Function zbMakeDWord( _
HiWord As Integer, _
LoWord As Integer) As Long
Dim aInt(0 To 1) As Integer
aInt(0) = LoWord:      aInt(1) = HiWord
CopyMemory zbMakeDWord, aInt(0), 4
End Function


Private Function zbMakeWord( _
HiByte As Byte, _
LoByte As Byte) As Integer
Dim aByte(0 To 1) As Byte
aByte(0) = LoByte:      aByte(1) = HiByte
CopyMemory zbMakeWord, aByte(0), 2
End Function


' zwraca DWord z przekazanej tablicy zawierającej cztery bajty,
' bez konieczności tworzenia starszego i młodszego słowa

Private Function zbHiLoByteToDWord(aByte() As Byte) As Long
CopyMemory zbHiLoByteToDWord, aByte(0), 4
End Function


' zwraca ByRef w tablicy aWord() starsze i młodsze słowo
' i ByRef w tablicy aByte() wszystkie bajty,

Private Sub zbRetHiLoWordByte( _
lDWord As Long, _
aWord() As Integer, _
aByte() As Byte)
CopyMemory aWord(0), lDWord, 4
CopyMemory aByte(0), lDWord, 4
End Sub


' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim bHiByte_Hi As Byte, bHiByte_Lo As Byte
Dim bLoByte_Hi As Byte, bLoByte_Lo As Byte
Dim iHiWord As Integer, iLoWord As Integer
Dim aWords(0 To 1) As Integer
Dim aBytes(0 To 3) As Byte
Dim lDWord As Long

' ustawmy poszczególne bajty
bHiByte_Hi = 9: bHiByte_Lo = 8
bLoByte_Hi = 7: bLoByte_Lo = 6

' Metoda I - MSDN + poprawki Krzysztofa Naworyty
Debug.Print String(20, "="); " MSDN "; String(29, "=")

iHiWord = MakeWord(bHiByte_Hi, bHiByte_Lo)
iLoWord = MakeWord(bLoByte_Hi, bLoByte_Lo)
lDWord = MakeDWord(iHiWord, iLoWord)

Debug.Print "HiWord ="; iHiWord, _
"Hi_HiByte"; bHiByte_Hi, "Hi_LoByte"; bHiByte_Lo
Debug.Print "LoWord ="; iLoWord, _
"Lo_HiByte"; bLoByte_Hi, "Lo_LoByte"; bLoByte_Lo
Debug.Print "DWord ="; lDWord
Debug.Print String(20, "="); " CopyMemory "; String(23, "=")

' Metoda II - za pomocą funkcji CopyMemory
iHiWord = zbMakeWord(bHiByte_Hi, bHiByte_Lo)
iLoWord = zbMakeWord(bLoByte_Hi, bLoByte_Lo)
lDWord = zbMakeDWord(iHiWord, iLoWord)

Debug.Print "HiWord ="; iHiWord, _
"Hi_HiByte"; bHiByte_Hi, "Hi_LoByte"; bHiByte_Lo
Debug.Print "LoWord ="; iLoWord, _
"Lo_HiByte"; bLoByte_Hi, "Lo_LoByte"; bLoByte_Lo
Debug.Print "DWord ="; lDWord
Debug.Print ; String(20, "="); " DWord => CopyMemory ";
Debug.Print ; String(14, "=")

' Test - spróbujmy ze zmiennej lDWord odczytać starsze
' i młodsze słowo oraz starsze i młodsze bajty za pomocą
' funkcji CopyMemory

zbRetHiLoWordByte lDWord, aWords(), aBytes()

Debug.Print "DWord ="; lDWord
Debug.Print "HiWord ="; aWords(1), _
"Hi_HiByte"; aBytes(3), "Hi_LoByte"; aBytes(2)
Debug.Print "LoWord ="; aWords(0), _
"Lo_HiByte"; aBytes(1), "Lo_LoByte"; aBytes(0)

DoCmd.RunCommand acCmdDebugWindow

End Sub

 ΔΔΔ 

 

5.7 Jak przekonwertować liczbę do postaci Hexadecymalnej i odwrotnie ?

grupa: pl.comp.bazy-danych.msaccess
wątek: Konwersja z HEX
w oparciu o artykuł: Krzysztofa Naworyty



Private Sub btnTest_Click()
Dim sHex As String
Const MY_TEST As Long = 2141234547

' Dec => Hex
sHex = Hex$(MY_TEST)
' Hex => Dec
Debug.Print "Dec: "; MY_TEST; "=> Hex: "; sHex; _
" => knHexToDec: "; knHexToDec(sHex)
DoCmd.RunCommand acCmdDebugWindow

End Sub


Private Function knHexToDec(sHex As String) As Long
knHexToDec = CLng("&H" & sHex)
End Function


' komentarz Krzysztofa Czuryło:
' <cyt>
    
Prostota tego rozwiązania jest urzekająca! :-)
</cyt>

 ΔΔΔ 

 

5.8 Jak przypisać do zmiennej Variant (podtyp Decimal) liczbe przekraczajacą zakres typu Long np. 10888869450418352160768000000 ?

grupa: pl.comp.bazy-danych.msaccess
wątek: Przypisanie do zmiennej Variant
autor: Krzysztof Pozorek



<cyt>
' Musi być wartość funkcji CDec w cudzysłowiu,
' inaczej argumet jest konwertowany do Double,
' czyli:

Debug.Print CDec("10888869450418352160768000001") - _
CDec("10888869450418352160768000000")
</cyt>


' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim v1 As Variant, v2 As Variant

v1 = CDec("10888869450418352160768000001")
v2 = CDec("10888869450418352160768000000")
Debug.Print v1; "-"; v2; " = "; v1 - v2
DoCmd.RunCommand acCmdDebugWindow

End Sub


' pozwolę sobie dodać komentarz Krzysztofa Naworyty
' <cyt>
    ' Zważywszy, że CDec() istnieje od a'97 (czyli mniej więcej od 8-u lat!) jest dla mnie niesamowitością kompletną, że dopiero teraz dowiaduję się o pewnych "smaczkach" !
</cyt>

 ΔΔΔ 

 

5.9 Jak pobrać ilość dni w miesiacu dla danego roku ?

grupa: pl.comp.bazy-danych.msaccess
wątek: http://tinyurl.com/qumnj
w oparciu o artykuł: Rafała Posmyka



' zwraca ilość dni w miesiącu określonego roku
Private Function rpDaysInMonth(iYear As Integer, _
iMonth As Integer) As Integer
rpDaysInMonth = Day(DateSerial(iYear, iMonth + 1, 1) - 1)
End Function


' - na podstawie HELP Access' 97:
'   zwraca ilość dni w miesiącu dla określonej daty

Function DaysInMonth(dteInput As Date) As Integer
Dim intDays As Integer

' dodaj miesiąc i pobierz różnicę
intDays = DateSerial(Year(dteInput), Month(dteInput) + 1, _
Day(dteInput)) - DateSerial(Year(dteInput), _
Month(dteInput), Day(dteInput))
DaysInMonth = intDays

End Function


' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim intDays As Integer
' HELP Access' 97
intDays = DaysInMonth(#2/1/04#) ' 01 luty 2004
Debug.Print "1. "; "#2/1/04# ", , intDays
' zależne od ustawień regionalnych
intDays = DaysInMonth("1-2-2004")
Debug.Print "2. "; "1-2-2004 ", , intDays
 ' zależne od wersji językowej
' intDays = DaysInMonth("February 1, 2004")
' zależne od wersji językowej
intDays = DaysInMonth("Luty 1, 2004")
Debug.Print "3. "; "Luty 1, 2004 ", intDays
' Rafał Posmyk
Debug.Print "4. "; "rpDaysInMonth: ", rpDaysInMonth(2004, 2)
DoCmd.RunCommand acCmdDebugWindow

End Sub

 ΔΔΔ