Functie UDF pentru conversie cifre in cuvinte

smcsa
Mesaje: 2805
Membru din: Mar Sep 29, 2009 7:29 pm
Localitate: Timisoara

Functie UDF pentru conversie cifre in cuvinte

Mesaj de smcsa » Mar Noi 10, 2009 4:13 pm

Daca aveti nevoie pentru generare de chitante, de exemplu. Functia e valabila pentru sume de pana la 999,99 lei

Cod: Selectaţi tot

Function No2Char(numar as double)
 Dim lei as Double
 Dim bani as Double
 Dim numarcifre as String
 Dim nr1 as String 'leiincifre
 Dim nr2 as String 'leu sau lei
 Dim nr3 as String 'si sau nimic
 Dim nr4 as String 'bani in cifre
 Dim nr5 as String 'ban sau bani
 Dim Unitati()
 Dim Zeci()
 
 Unitati()= Array("zero", "unu", "doi", "trei", "patru", "cinci", "sase", "sapte", "opt", "noua", "zece", "unsprezece", "doisprezece", "treisprezece", "patrusprezece", "cincisprezece", "saisprezece", "saptesprezece", "optsprezece", "nouasprezece", "douazeci")
 Zeci() = Array("zero", "zece", "douazeci", "treizeci", "patruzeci", "cincizeci", "saizeci", "saptezeci", "optzeci", "nouazeci")
 if numar > 999.99 then
  No2Char = "????????????????????????????????????????????????????????????????"
  exit function
 end if

 lei = Fix(numar)
 bani = (numar - lei) * 100
 lei_init = lei
 bani_init = bani

 if lei > 99 then
  nr1 = Unitati(Fix(lei / 100)) + "sute"
  if nr1 = "unusute" then nr1 = "unasuta"
  lei = lei MOD 100
 end if
 if lei > 20 then
  nr1 = nr1 + Zeci(Fix(lei / 10))
  lei = lei mod 10
  if lei > 0 then nr1 = nr1 + "si"
 end if
 
 if lei>0 or lei_init=0 then nr1 = nr1 + Unitati(lei)
 if nr1 = "unu" then nr1 = "un"
 
 if bani > 20 then
  nr4 = nr4 + Zeci(Fix(bani / 10))
  bani = bani mod 10
  if bani > 0 then nr4 = nr4 + "si"
 end if
 
 if bani>0 then nr4 = nr4 + Unitati(bani)
 if nr4 = "unu" then nr4 = "un"

 if lei_init = 1 then nr2 = "leu" else nr2 = "lei"
 if bani_init = 1 then nr5 = "ban"
 if bani_init > 0 then nr3 = "si"
 if bani_init > 1 then nr5 = "bani"
 
 No2Char = nr1 + nr2 + nr3 + nr4 + nr5
 
End Function

smcsa
Mesaje: 2805
Membru din: Mar Sep 29, 2009 7:29 pm
Localitate: Timisoara

Re: Functie UDF pentru conversie cifre in cuvinte

Mesaj de smcsa » Dum Dec 06, 2009 10:54 am

O mica precizare: daca lucrati cu

Cod: Selectaţi tot

Option Base 1
va trebui sa faceti urmatoarele modificari:

Cod: Selectaţi tot

nr1 = Unitati(Fix(lei / 100) + 1) + "sute"
....
nr1 = nr1 + Zeci(Fix(lei / 10) + 1)
....
If lei > 0 Or lei_init = 0 Then nr1 = nr1 + Unitati(lei + 1)
....
nr4 = nr4 + Zeci(Fix(bani / 10) + 1)
....
If bani > 0 Then nr4 = nr4 + Unitati(bani + 1)
adica peste tot unde aveti array adaugati 1 la indice

fanel1963
Mesaje: 13
Membru din: Sâm Oct 16, 2010 5:59 pm

Re: Functie UDF pentru conversie cifre in cuvinte

Mesaj de fanel1963 » Mie Noi 03, 2010 5:55 pm

Cod: Selectaţi tot

Function NumToText(numStr As String) As String
Dim LeftStr, RightStr As String
Dim commaPos, i As Byte
commaPos = InStr(numStr, ".")
If commaPos Then
LeftStr = Replace((Left(numStr, commaPos - 1)), ".", "")
RightStr = Right(numStr, Len(numStr) - commaPos)
Else
LeftStr = Replace(numStr, ".", "")
RightStr = ""
End If
Dim gn As Byte 'three-Unitati-group number
Dim L As Byte
L = Len(LeftStr)
Select Case L Mod 3
Case 0:
gn = L \ 3
Case 1:
gn = L \ 3 + 1
LeftStr = "00" & LeftStr
Case 2:
gn = L \ 3 + 1
LeftStr = "0" & LeftStr
End Select

Dim GroupStr() As String 'Three-Unitati-Group String
ReDim GroupStr(gn - 1)
For i = 0 To gn - 1
GroupStr(gn - 1 - i) = Mid(LeftStr, (i * 3) + 1, 3)
GroupStr(gn - 1 - i) = GroupNumToText(GroupStr(gn - 1 - i))
Next
LeftStr = ""
For i = 0 To gn - 1
Select Case i
Case 0:
LeftStr = GroupStr(i) & LeftStr & "Lei "
Case 1:
If GroupStr(i) <> "" Then LeftStr = GroupStr(i) & "Mii " & LeftStr
Case 2:
If GroupStr(i) <> "" Then LeftStr = GroupStr(i) & "Millioane " & LeftStr
Case 3:
If GroupStr(i) <> "" Then LeftStr = GroupStr(i) & "Miliarde " & LeftStr
End Select
Next

If RightStr <> "" Then
RightStr = " si " & GroupNumToText("0" & Left(RightStr, 2)) & "bani "
End If
NumToText = LeftStr & RightStr

End Function

Private Function GroupNumToText(num As String) As String
Dim str(2) As String
Dim i As Byte

For i = 0 To 2
Select Case i
Case 0:
Select Case Mid(num, i + 1, 1)
Case "0":
str(i) = ""
Case "1":
str(i) = "Una "
Case "2":
str(i) = "Doua "
Case "3"
str(i) = "Trei "
Case "4":
str(i) = "Patru "
Case "5":
str(i) = "Cinci "
Case "6":
str(i) = "Sase "
Case "7":
str(i) = "Sapte "
Case "8":
str(i) = "Opt "
Case "9":
str(i) = "Noua "
End Select
If str(i) <> "" Then str(i) = str(i) & "Sute "
Case 1:
Select Case Mid(num, i + 1, 1)
Case "0":
str(i) = ""
Case "1":
str(i) = "Zece"
Case "2":
str(i) = "Douazecisi "
Case "3"
str(i) = "Treizecisi "
Case "4":
str(i) = "Patruzecisi "
Case "5":
str(i) = "Cincizecisi "
Case "6":
str(i) = "Saizecisi "
Case "7":
str(i) = "Saptezecisi "
Case "8":
str(i) = "Optzecisi "
Case "9":
str(i) = "Nouazecisi "
End Select
Case 2:
If str(1) = "Zece" Then
str(i) = ""
Select Case Mid(num, i + 1, 1)
Case "0":
str(i) = "Zece "
Case "1":
str(i) = "Unsprezece "
Case "2":
str(i) = "Doisprezece "
Case "3"
str(i) = "Treisprezece "
Case "4":
str(i) = "Paisprezece "
Case "5":
str(i) = "Cinsprezece "
Case "6":
str(i) = "Saisprezece "
Case "7":
str(i) = "Saptesprezece "
Case "8":
str(i) = "Optusprezece "
Case "9":
str(i) = "Noasprezece "
End Select
str(1) = ""
Else
Select Case Mid(num, i + 1, 1)
Case "0":
str(i) = ""
Case "1":
str(i) = "Un"
Case "2":
str(i) = "Doi "
Case "3"
str(i) = "Trei"
Case "4":
str(i) = "Patru "
Case "5":
str(i) = "Cinci "
Case "6":
str(i) = "Sase "
Case "7":
str(i) = "Sapte "
Case "8":
str(i) = "Opt "
Case "9":
str(i) = "Noua "
End Select
End If
End Select
Next
GroupNumToText = str(0) & str(1) & str(2)
End Function
Ultima oară modificat Mie Noi 03, 2010 6:01 pm de către Anonymous, modificat 1 dată în total.
Motiv: Adaugare tag-uri CODE

florinpapuc
Mesaje: 19
Membru din: Vin Apr 22, 2011 7:02 am

Re: Functie UDF pentru conversie cifre in cuvinte

Mesaj de florinpapuc » Joi Mai 05, 2011 12:40 pm

smcsa scrie:Daca aveti nevoie pentru generare de chitante, de exemplu. Functia e valabila pentru sume de pana la 999,99 lei

Cod: Selectaţi tot

Function No2Char(numar as double)
 Dim lei as Double
 Dim bani as Double
 Dim numarcifre as String
 Dim nr1 as String 'leiincifre
 Dim nr2 as String 'leu sau lei
 Dim nr3 as String 'si sau nimic
 Dim nr4 as String 'bani in cifre
 Dim nr5 as String 'ban sau bani
 Dim Unitati()
 Dim Zeci()
 
 Unitati()= Array("zero", "unu", "doi", "trei", "patru", "cinci", "sase", "sapte", "opt", "noua", "zece", "unsprezece", "doisprezece", "treisprezece", "patrusprezece", "cincisprezece", "saisprezece", "saptesprezece", "optsprezece", "nouasprezece", "douazeci")
 Zeci() = Array("zero", "zece", "douazeci", "treizeci", "patruzeci", "cincizeci", "saizeci", "saptezeci", "optzeci", "nouazeci")
 if numar > 999.99 then
  No2Char = "????????????????????????????????????????????????????????????????"
  exit function
 end if

 lei = Fix(numar)
 bani = (numar - lei) * 100
 lei_init = lei
 bani_init = bani

 if lei > 99 then
  nr1 = Unitati(Fix(lei / 100)) + "sute"
  if nr1 = "unusute" then nr1 = "unasuta"
  lei = lei MOD 100
 end if
 if lei > 20 then
  nr1 = nr1 + Zeci(Fix(lei / 10))
  lei = lei mod 10
  if lei > 0 then nr1 = nr1 + "si"
 end if
 
 if lei>0 or lei_init=0 then nr1 = nr1 + Unitati(lei)
 if nr1 = "unu" then nr1 = "un"
 
 if bani > 20 then
  nr4 = nr4 + Zeci(Fix(bani / 10))
  bani = bani mod 10
  if bani > 0 then nr4 = nr4 + "si"
 end if
 
 if bani>0 then nr4 = nr4 + Unitati(bani)
 if nr4 = "unu" then nr4 = "un"

 if lei_init = 1 then nr2 = "leu" else nr2 = "lei"
 if bani_init = 1 then nr5 = "ban"
 if bani_init > 0 then nr3 = "si"
 if bani_init > 1 then nr5 = "bani"
 
 No2Char = nr1 + nr2 + nr3 + nr4 + nr5
 
End Function
Salut. Poti sa explici unde trebuie sa lipesc aceste formule?
Multumesc.
Sunt incepator dar vreau sa invat.
Scuze daca te deranjeaza ce postez. Cred ca sunt si mai incepatori ca mine.

smcsa
Mesaje: 2805
Membru din: Mar Sep 29, 2009 7:29 pm
Localitate: Timisoara

Re: Functie UDF pentru conversie cifre in cuvinte

Mesaj de smcsa » Joi Mai 05, 2011 12:50 pm

Daca ma deranja spuneam ca ma deranjeaza. Am spus doar ca sunt ciudate.

O functie definita de utilizator (UDF) se foloseste la fel ca orice functie proprie Excel. Asa cum ai =SUM(A1:A3), tot asa folosesti =functia_mea(A1:A3)

Legat de No2Char: copiezi codul, deschizi Excel, Alt+F11, Insert - Module si in acel modul (in fereastra din dreapta) dai Paste. Inchizi editorul VBA, scrii un numar in A1 si in A2 scrii =No2Char(A1)

florinpapuc
Mesaje: 19
Membru din: Vin Apr 22, 2011 7:02 am

Re: Functie UDF pentru conversie cifre in cuvinte

Mesaj de florinpapuc » Joi Mai 05, 2011 1:04 pm

Multumesc. Am mai aflat ceva. Ssper sa imi ajute.
Ultima oară modificat Joi Mai 05, 2011 1:08 pm de către smcsa, modificat 1 dată în total.
Motiv: Scos citat anterior

smcsa
Mesaje: 2805
Membru din: Mar Sep 29, 2009 7:29 pm
Localitate: Timisoara

Re: Functie UDF pentru conversie cifre in cuvinte

Mesaj de smcsa » Joi Mai 05, 2011 1:08 pm

Bine, dar nu mai cita mesajul imediat anterior, da pe butonul "Raspuns"

Avatar utilizator
mesersmith
Mesaje: 2088
Membru din: Sâm Oct 23, 2010 6:44 am
Localitate: calarasi
Contact:

Re: Functie UDF pentru conversie cifre in cuvinte

Mesaj de mesersmith » Joi Mai 05, 2011 1:09 pm

pentru access, se patreaza acelasi cod?
e f intersant codul si chiar ma intrebam cum pot scrie cu litere suma intr-o chitanta.

smcsa
Mesaje: 2805
Membru din: Mar Sep 29, 2009 7:29 pm
Localitate: Timisoara

Re: Functie UDF pentru conversie cifre in cuvinte

Mesaj de smcsa » Joi Mai 05, 2011 1:13 pm

Cred ca da, n-am incercat in Access. Dar vezi ca eu am dat codul doar cu titlu didactic, trebuie modificat sa mearga pana la 5.000 cat e limita legala, daca vrei sa aplici in productie.

Avatar utilizator
mesersmith
Mesaje: 2088
Membru din: Sâm Oct 23, 2010 6:44 am
Localitate: calarasi
Contact:

Re: Functie UDF pentru conversie cifre in cuvinte

Mesaj de mesersmith » Joi Mai 05, 2011 1:28 pm

pai n-o sa modific codul sa mearga doar pana la 5000, ca se schimba legea si iar trebuie sa modifici.
toti cei care fac facturi, stiu sau ar trebui sa stie de existenta acestei limite.
o sa incerc sa vad daca merge.

Închis

Înapoi la “Visual Basic for Application (VBA) cu Excel - Intrebari tehnice”