POR EXTENSO EM CRYSTAL REPORTS 10
POR FAVOR, PRECISO ESCREVER VALORES POR EXTENSO NO CRYSTAL REPORTS 10, JÃ TENTEI COLAR A DLL CRXLATE.DLL NA PASTA C:/ WINDOWS / SYSTEM32 E TAMBéM NA SYSTEM, MAS NADA FUNCIONOU, O QUE DEVO FAZER?
Já tive este problema se atente pois tem 2 dll uma 16bits e outra 32 bits ..da uma pesquisada pra ver isso porem tem outra forma ja usei este esquema que o cara fez e funciona com algumas correções, ja usei ele mas não achei o rpt que coloquei ... tah ai o link .. espero que te sirva ... peguei no forum http://info.abril.com.br/forum-antigo/forum.php?topico=65504
Feito por: Fernando Luis Groeler - Forum Info : http://info.abril.com.br/forum-antigo/forum.php?topico=65504
se naum tiver a DLL
em português, cria duas formulas...
uma chamada Extenso e outra chamada AsterÃstico.
na Formula Extenso vc vai colocar o seguinte:
OBS.: formulas deve estar na sintaxe basic.
Dim sValor As String
Dim sInt As String
Dim sDec As String
Dim nI As Number
Dim sExt As String
Dim sNum As String
sValor = CStr(({@total}))
sValor = Replace( sValor, [Ô].[Ô], [Ô][Ô])
[ô] Matriz de nomes
Dim mUni(10) As String
Dim mDez(10) As String
Dim mCen(10) As String
Dim mDecima(10) As String
Dim mPos(11) As String
mPos(1) = [Ô]Real[Ô]
mPos(2) = [Ô]Mil[Ô]
mPos(3) = [Ô]Milhão[Ô]
mPos(4) = [Ô]Bilhão[Ô]
mPos(5) = [Ô]Trilhão[Ô]
mPos(6) = [Ô]Reais[Ô]
mPos(7) = [Ô]Mil[Ô]
mPos(8) = [Ô]Milhões[Ô]
mPos(9) = [Ô]Bilhões[Ô]
mPos(10) = [Ô]Trilhões[Ô]
mUni(1) = [Ô]Um[Ô]
mUni(2) = [Ô]Dois[Ô]
mUni(3) = [Ô]Três[Ô]
mUni(4) = [Ô]Quatro[Ô]
mUni(5) = [Ô]Cinco[Ô]
mUni(6) = [Ô]Seis[Ô]
mUni(7) = [Ô]Sete[Ô]
mUni(8) = [Ô]Oito[Ô]
mUni(9) = [Ô]Nove[Ô]
[ô]mDecima(0) = [Ô]Dez[Ô]
mDecima(1) = [Ô]Onze[Ô]
mDecima(2) = [Ô]Doze[Ô]
mDecima(3) = [Ô]Treze[Ô]
mDecima(4) = [Ô]Quatorze[Ô]
mDecima(5) = [Ô]Quinze[Ô]
mDecima(6) = [Ô]Dezesseis[Ô]
mDecima(7) = [Ô]Dezessete[Ô]
mDecima(8) = [Ô]Dezoito[Ô]
mDecima(9) = [Ô]Dezenove[Ô]
mDez(1) = [Ô]Dez[Ô]
mDez(2) = [Ô]Vinte[Ô]
mDez(3) = [Ô]Trinta[Ô]
mDez(4) = [Ô]Quarenta[Ô]
mDez(5) = [Ô]Cinquenta[Ô]
mDez(6) = [Ô]Sessenta[Ô]
mDez(7) = [Ô]Setenta[Ô]
mDez(8) = [Ô]Oitenta[Ô]
mDez(9) = [Ô]Noventa[Ô]
mCen(1) = [Ô]Cento[Ô]
mCen(2) = [Ô]Duzentos[Ô]
mCen(3) = [Ô]Trezentos[Ô]
mCen(4) = [Ô]Quatrocentos[Ô]
mCen(5) = [Ô]Quinhentos[Ô]
mCen(6) = [Ô]Seiscentos[Ô]
mCen(7) = [Ô]Setecentos[Ô]
mCen(8) = [Ô]Oitocentos[Ô]
mCen(9) = [Ô]Novecentos[Ô]
[ô] Separando Inteiros e Decimais
If InStr(sValor, [Ô],[Ô]) > 0 Then
sInt = Mid(sValor, 1, InStr(sValor, [Ô],[Ô]) - 1)
sDec = Mid(sValor, InStr(sValor, [Ô],[Ô]) + 1)
Else
sInt = sValor
sDec = [Ô][Ô]
End If
[ô] Dando nome aos Bois
Dim nPos As Number, nDig As Number, sValorExtenso As String, nPosGeral As Number
[ô] Inteiro
sExt = [Ô][Ô]
nI = Len(sInt)
nPos = 1
nPosGeral = 1
Do While nI > 0
nDig = Val(Mid(sInt, nI, 1))
If nPos = 1 Then
[ô] Particularidades da Unidade: Verificando se é um valor entre 11 e 19
If nI > 1 Then
If Val(Mid(sInt, nI - 1, 1)) = 1 Then
if nDig = 0 then
sExt=[Ô]dez[Ô]
else
sExt = mDecima(nDig)
end if
nPos = 2
nI = nI - 1
End If
End If
[ô] Não atendeu, simplesmente recupera o nome
If sExt = [Ô][Ô] And nDig > 0 Then
sExt = mUni(nDig)
End If
ElseIf nPos = 2 And nDig > 0 Then
[ô] Dezenas
If Val(Mid(sInt, nI + 1, 1)) = 0 Then
sExt = mDez(nDig)
Else
sExt = mDez(nDig) & [Ô] e [Ô] & sExt
End If
ElseIf nPos = 3 And nDig > 0 Then
[ô] Centenas
If sExt = [Ô][Ô] Then
if nDig = 1 then
sExt = [Ô]cem[Ô]
else
sExt = mCen(nDig)
end if
Else
sExt = mCen(nDig) & [Ô] e [Ô] & sExt
End If
End If
nI = nI - 1
nPos = nPos + 1
[ô] Gravando o Total
If nPos = 4 Or nI = 0 Then
If sExt <> [Ô][Ô] Then
If sExt = [Ô]um[Ô] Then
sExt = sExt & [Ô] [Ô] & mPos(nPosGeral)
Else
sExt = sExt & [Ô] [Ô] & mPos(nPosGeral + 5)
End If
If sValorExtenso <> [Ô][Ô] Then
sValorExtenso = sExt & [Ô], [Ô] & sValorExtenso
Else
sValorExtenso = sExt
End If
End If
sExt = [Ô][Ô]
nPosGeral = nPosGeral + 1
nPos = 1
End If
Loop
If Right(sValorExtenso, 5) <> [Ô]reais[Ô] and Right(sValorExtenso, 4) <> [Ô]real[Ô] Then
sValorExtenso = sValorExtenso & [Ô] reais[Ô]
End If
[ô] Decimais
If Val(sDec) > 0 Then
If Len(sDec) = 1 Then
sDec = sDec & [Ô]0[Ô]
ElseIf Len(sDec) > 2 Then
sDec = Mid(sDec, 1, 2)
End If
sExt = [Ô][Ô]
For nI = 1 To 2
nDig = Val(Mid(sDec, nI, 1))
If nI = 1 Then
If nDig = 1 And Val(Mid(sDec, 2, 1)) > 0 Then
sExt = mDecima(Val(Mid(sDec, 2, 1)))
exit for
Else
if nDig > 0 then
sExt = mDez(nDig)
If Val(Mid(sDec, 2, 1)) > 0 Then sExt = sExt & [Ô] e [Ô]
end if
End If
Else
If nDig > 0 Then
sExt = sExt & mUni(nDig)
End If
End If
Next nI
if sExt = [Ô]um[Ô] then
sExt=[Ô]um centavo[Ô]
else
sExt=sExt & [Ô] centavos[Ô]
end if
If sExt <> [Ô][Ô] Then
sValorExtenso = sValorExtenso & [Ô] e [Ô] & sExt
End If
End If
Formula = sValorExtenso
*substituindo o campo [Ô]@total}[Ô] logo no inÃcio da formula, pelo campo que deseja por Extenso
na formula AsterÃstico coloque:
dim sExtenso as String
sExtenso = {@Extenso}
Formula = sExtenso & ReplicateString ( [Ô] *[Ô], 50 - (Len(sExtenso) 2 ) )
Feito por: Fernando Luis Groeler - Forum Info : http://info.abril.com.br/forum-antigo/forum.php?topico=65504
se naum tiver a DLL
em português, cria duas formulas...
uma chamada Extenso e outra chamada AsterÃstico.
na Formula Extenso vc vai colocar o seguinte:
OBS.: formulas deve estar na sintaxe basic.
Dim sValor As String
Dim sInt As String
Dim sDec As String
Dim nI As Number
Dim sExt As String
Dim sNum As String
sValor = CStr(({@total}))
sValor = Replace( sValor, [Ô].[Ô], [Ô][Ô])
[ô] Matriz de nomes
Dim mUni(10) As String
Dim mDez(10) As String
Dim mCen(10) As String
Dim mDecima(10) As String
Dim mPos(11) As String
mPos(1) = [Ô]Real[Ô]
mPos(2) = [Ô]Mil[Ô]
mPos(3) = [Ô]Milhão[Ô]
mPos(4) = [Ô]Bilhão[Ô]
mPos(5) = [Ô]Trilhão[Ô]
mPos(6) = [Ô]Reais[Ô]
mPos(7) = [Ô]Mil[Ô]
mPos(8) = [Ô]Milhões[Ô]
mPos(9) = [Ô]Bilhões[Ô]
mPos(10) = [Ô]Trilhões[Ô]
mUni(1) = [Ô]Um[Ô]
mUni(2) = [Ô]Dois[Ô]
mUni(3) = [Ô]Três[Ô]
mUni(4) = [Ô]Quatro[Ô]
mUni(5) = [Ô]Cinco[Ô]
mUni(6) = [Ô]Seis[Ô]
mUni(7) = [Ô]Sete[Ô]
mUni(8) = [Ô]Oito[Ô]
mUni(9) = [Ô]Nove[Ô]
[ô]mDecima(0) = [Ô]Dez[Ô]
mDecima(1) = [Ô]Onze[Ô]
mDecima(2) = [Ô]Doze[Ô]
mDecima(3) = [Ô]Treze[Ô]
mDecima(4) = [Ô]Quatorze[Ô]
mDecima(5) = [Ô]Quinze[Ô]
mDecima(6) = [Ô]Dezesseis[Ô]
mDecima(7) = [Ô]Dezessete[Ô]
mDecima(8) = [Ô]Dezoito[Ô]
mDecima(9) = [Ô]Dezenove[Ô]
mDez(1) = [Ô]Dez[Ô]
mDez(2) = [Ô]Vinte[Ô]
mDez(3) = [Ô]Trinta[Ô]
mDez(4) = [Ô]Quarenta[Ô]
mDez(5) = [Ô]Cinquenta[Ô]
mDez(6) = [Ô]Sessenta[Ô]
mDez(7) = [Ô]Setenta[Ô]
mDez(8) = [Ô]Oitenta[Ô]
mDez(9) = [Ô]Noventa[Ô]
mCen(1) = [Ô]Cento[Ô]
mCen(2) = [Ô]Duzentos[Ô]
mCen(3) = [Ô]Trezentos[Ô]
mCen(4) = [Ô]Quatrocentos[Ô]
mCen(5) = [Ô]Quinhentos[Ô]
mCen(6) = [Ô]Seiscentos[Ô]
mCen(7) = [Ô]Setecentos[Ô]
mCen(8) = [Ô]Oitocentos[Ô]
mCen(9) = [Ô]Novecentos[Ô]
[ô] Separando Inteiros e Decimais
If InStr(sValor, [Ô],[Ô]) > 0 Then
sInt = Mid(sValor, 1, InStr(sValor, [Ô],[Ô]) - 1)
sDec = Mid(sValor, InStr(sValor, [Ô],[Ô]) + 1)
Else
sInt = sValor
sDec = [Ô][Ô]
End If
[ô] Dando nome aos Bois
Dim nPos As Number, nDig As Number, sValorExtenso As String, nPosGeral As Number
[ô] Inteiro
sExt = [Ô][Ô]
nI = Len(sInt)
nPos = 1
nPosGeral = 1
Do While nI > 0
nDig = Val(Mid(sInt, nI, 1))
If nPos = 1 Then
[ô] Particularidades da Unidade: Verificando se é um valor entre 11 e 19
If nI > 1 Then
If Val(Mid(sInt, nI - 1, 1)) = 1 Then
if nDig = 0 then
sExt=[Ô]dez[Ô]
else
sExt = mDecima(nDig)
end if
nPos = 2
nI = nI - 1
End If
End If
[ô] Não atendeu, simplesmente recupera o nome
If sExt = [Ô][Ô] And nDig > 0 Then
sExt = mUni(nDig)
End If
ElseIf nPos = 2 And nDig > 0 Then
[ô] Dezenas
If Val(Mid(sInt, nI + 1, 1)) = 0 Then
sExt = mDez(nDig)
Else
sExt = mDez(nDig) & [Ô] e [Ô] & sExt
End If
ElseIf nPos = 3 And nDig > 0 Then
[ô] Centenas
If sExt = [Ô][Ô] Then
if nDig = 1 then
sExt = [Ô]cem[Ô]
else
sExt = mCen(nDig)
end if
Else
sExt = mCen(nDig) & [Ô] e [Ô] & sExt
End If
End If
nI = nI - 1
nPos = nPos + 1
[ô] Gravando o Total
If nPos = 4 Or nI = 0 Then
If sExt <> [Ô][Ô] Then
If sExt = [Ô]um[Ô] Then
sExt = sExt & [Ô] [Ô] & mPos(nPosGeral)
Else
sExt = sExt & [Ô] [Ô] & mPos(nPosGeral + 5)
End If
If sValorExtenso <> [Ô][Ô] Then
sValorExtenso = sExt & [Ô], [Ô] & sValorExtenso
Else
sValorExtenso = sExt
End If
End If
sExt = [Ô][Ô]
nPosGeral = nPosGeral + 1
nPos = 1
End If
Loop
If Right(sValorExtenso, 5) <> [Ô]reais[Ô] and Right(sValorExtenso, 4) <> [Ô]real[Ô] Then
sValorExtenso = sValorExtenso & [Ô] reais[Ô]
End If
[ô] Decimais
If Val(sDec) > 0 Then
If Len(sDec) = 1 Then
sDec = sDec & [Ô]0[Ô]
ElseIf Len(sDec) > 2 Then
sDec = Mid(sDec, 1, 2)
End If
sExt = [Ô][Ô]
For nI = 1 To 2
nDig = Val(Mid(sDec, nI, 1))
If nI = 1 Then
If nDig = 1 And Val(Mid(sDec, 2, 1)) > 0 Then
sExt = mDecima(Val(Mid(sDec, 2, 1)))
exit for
Else
if nDig > 0 then
sExt = mDez(nDig)
If Val(Mid(sDec, 2, 1)) > 0 Then sExt = sExt & [Ô] e [Ô]
end if
End If
Else
If nDig > 0 Then
sExt = sExt & mUni(nDig)
End If
End If
Next nI
if sExt = [Ô]um[Ô] then
sExt=[Ô]um centavo[Ô]
else
sExt=sExt & [Ô] centavos[Ô]
end if
If sExt <> [Ô][Ô] Then
sValorExtenso = sValorExtenso & [Ô] e [Ô] & sExt
End If
End If
Formula = sValorExtenso
*substituindo o campo [Ô]@total}[Ô] logo no inÃcio da formula, pelo campo que deseja por Extenso
na formula AsterÃstico coloque:
dim sExtenso as String
sExtenso = {@Extenso}
Formula = sExtenso & ReplicateString ( [Ô] *[Ô], 50 - (Len(sExtenso) 2 ) )
Tópico encerrado , respostas não são mais permitidas