[Tips] Modul emitere chitanta

trucuri, sfaturi si alte idei pentru imbunatatirea lucrului cu Access
Închis
Avatar utilizator
mesersmith
Mesaje: 2088
Membru din: Sâm Oct 23, 2010 6:44 am
Localitate: calarasi
Contact:

[Tips] Modul emitere chitanta

Mesaj de mesersmith » Mie Oct 30, 2013 11:03 am

Acum ceva vreme se discuta despre cum se poate automatiza emiterea unei chitante, de asa maniera incat sa preia suma in mod automat dintr-un tabel, s-o afiseze impreuna cu datele clientului si sa scrie suma in litere.
In rest, sunt diferite calcule simple, asupra carora nu mai insist ca nu are rost.


Astfel, am pus in atasament un mic modul care face toate aceste lucruri si care poate fi introdul in orice baza ca si modul component.
Codul care sta la baza scrierii cu litere a sumei este preluat, daca nu ma insel, de la colegii Smcsa si Alcoool.

Cod: Selectaţi tot

Function SpellNumber(ByVal MyNumber)

          Dim Dollars, Cents, Temp
          Dim DecimalPlace, Count
          ReDim Place(9) As String
          Place(2) = "mii "
          Place(3) = "milioane "
          Place(4) = "miliarde "
          Place(5) = "trilioane "

          MyNumber = Trim(str(MyNumber))

          DecimalPlace = InStr(MyNumber, ".")
          If DecimalPlace > 0 Then
             Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
              MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
          End If

          Count = 1
          Do While MyNumber <> ""
              Temp = GetHundreds(Right(MyNumber, 3))
              If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
              If Len(MyNumber) > 3 Then
                  MyNumber = Left(MyNumber, Len(MyNumber) - 3)
              Else
                  MyNumber = ""
              End If
              Count = Count + 1
          Loop

          Select Case Dollars
              Case ""
                  Dollars = "zero lei "
              Case "One"
                  Dollars = "un leu "
              Case Else
                  Dollars = Dollars & "lei "
          End Select

          Select Case Cents
              Case ""
                  Cents = "si zero bani"
              Case "One"
                  Cents = "si un ban"
              Case Else
                  Cents = "si " & Cents & "bani "
          End Select

          SpellNumber = Dollars & Cents
      End Function







      '*******************************************

      ' Converts a number from 100-999 into text *

      '*******************************************



      Function GetHundreds(ByVal MyNumber)

          Dim Result As String



          If Val(MyNumber) = 0 Then Exit Function
          MyNumber = Right("000" & MyNumber, 3)
          If Mid(MyNumber, 1, 1) <> "0" Then
              Result = GetDigit(Mid(MyNumber, 1, 1)) & "sute "
          End If

          If Mid(MyNumber, 2, 1) <> "0" Then
              Result = Result & GetTens(Mid(MyNumber, 2))
          Else
              Result = Result & GetDigit(Mid(MyNumber, 3))
          End If

          GetHundreds = Result
      End Function



     Function GetTens(TensText)
          Dim Result As String
          Result = ""     
          If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
              Select Case Val(TensText)
                  Case 10: Result = "zece "
                  Case 11: Result = "unsprezece "
                  Case 12: Result = "douasprezece "
                  Case 13: Result = "treisprezece "
                  Case 14: Result = "patrusprezece "
                  Case 15: Result = "cincisprezece "
                  Case 16: Result = "saisprezece "
                  Case 17: Result = "saptesprezece "
                  Case 18: Result = "optsprezece "
                  Case 19: Result = "nouasprezece "
                  Case Else
              End Select
          Else                                
              Select Case Val(Left(TensText, 1))

                  Case 2:
                         If Val(Left(TensText, 2)) = 20 Then
                            Result = "douazeci "
                         Else
                            Result = "douazeci si "
                         End If
                  Case 3:
                         If Val(Left(TensText, 2)) = 30 Then
                            Result = "treizeci "
                         Else
                            Result = "treizecisi"
                         End If

                  Case 4:
                         If Val(Left(TensText, 2)) = 40 Then
                            Result = "patruzeci"
                         Else
                            Result = "patruzeci si "
                         End If

                  Case 5:
                         If Val(Left(TensText, 2)) = 50 Then
                            Result = "cincizeci "
                         Else
                            Result = "cincizeci si "
                         End If

                  Case 6:
                         If Val(Left(TensText, 2)) = 60 Then
                            Result = "saizeci "
                         Else
                            Result = "saizeci si "
                         End If
                   
                  Case 7:
                         If Val(Left(TensText, 2)) = 70 Then
                            Result = "saptezeci "
                         Else
                            Result = "saptezeci si "
                         End If

                  Case 8:
                         If Val(Left(TensText, 2)) = 80 Then
                            Result = "optzeci "
                         Else
                            Result = "optzeci si "
                         End If
                   
                  Case 9:
                         If Val(Left(TensText, 2)) = 90 Then
                            Result = "nouazeci "
                         Else
                            Result = "nouazeci si "
                         End If                
                  Case Else
              End Select

              Result = Result & GetDigit(Right(TensText, 1))   ' Retrieve ones place.

          End If

          GetTens = Result

      End Function



      Function GetDigit(Digit)
          Select Case Val(Digit)
              Case 1: GetDigit = "unu "
              Case 2: GetDigit = "doua "
              Case 3: GetDigit = "trei "
              Case 4: GetDigit = "patru "
              Case 5: GetDigit = "cinci "
              Case 6: GetDigit = "sase "
              Case 7: GetDigit = "sapte "
              Case 8: GetDigit = "opt "
              Case 9: GetDigit = "noua "
              Case Else: GetDigit = ""
          End Select

      End Function
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.

Închis

Înapoi la “Tips and tricks in Access (indiferent de versiune)”