Functie UDF pentru conversie cifre in cuvinte

Functie UDF pentru conversie cifre in cuvinte

Mesajde 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

Mesajde 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
smcsa
 
Mesaje: 2805
Membru din: Mar Sep 29, 2009 7:29 pm
Localitate: Timisoara

Re: Functie UDF pentru conversie cifre in cuvinte

Mesajde 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 de Anonymous pe Mie Noi 03, 2010 6:01 pm, modificat 1 dată în total.
Motiv: Adaugare tag-uri CODE
fanel1963
 
Mesaje: 13
Membru din: Sâm Oct 16, 2010 5:59 pm

Re: Functie UDF pentru conversie cifre in cuvinte

Mesajde 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.
florinpapuc
 
Mesaje: 19
Membru din: Vin Apr 22, 2011 7:02 am

Re: Functie UDF pentru conversie cifre in cuvinte

Mesajde 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)
smcsa
 
Mesaje: 2805
Membru din: Mar Sep 29, 2009 7:29 pm
Localitate: Timisoara

Re: Functie UDF pentru conversie cifre in cuvinte

Mesajde florinpapuc » Joi Mai 05, 2011 1:04 pm

Multumesc. Am mai aflat ceva. Ssper sa imi ajute.
Ultima oară modificat de smcsa pe Joi Mai 05, 2011 1:08 pm, modificat 1 dată în total.
Motiv: Scos citat anterior
florinpapuc
 
Mesaje: 19
Membru din: Vin Apr 22, 2011 7:02 am

Re: Functie UDF pentru conversie cifre in cuvinte

Mesajde smcsa » Joi Mai 05, 2011 1:08 pm

Bine, dar nu mai cita mesajul imediat anterior, da pe butonul "Raspuns"
smcsa
 
Mesaje: 2805
Membru din: Mar Sep 29, 2009 7:29 pm
Localitate: Timisoara

Re: Functie UDF pentru conversie cifre in cuvinte

Mesajde 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.
Avatar utilizator
mesersmith
 
Mesaje: 2088
Membru din: Sâm Oct 23, 2010 6:44 am
Localitate: calarasi

Re: Functie UDF pentru conversie cifre in cuvinte

Mesajde 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.
smcsa
 
Mesaje: 2805
Membru din: Mar Sep 29, 2009 7:29 pm
Localitate: Timisoara

Re: Functie UDF pentru conversie cifre in cuvinte

Mesajde 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.
Avatar utilizator
mesersmith
 
Mesaje: 2088
Membru din: Sâm Oct 23, 2010 6:44 am
Localitate: calarasi

Următorul

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

Cine este conectat

Utilizatorii ce navighează pe acest forum: Niciun utilizator înregistrat şi 4 vizitatori