Spell number

Spell number

ramd401
Advocate Advocate
2,281 Views
14 Replies
Message 1 of 15

Spell number

ramd401
Advocate
Advocate

Hi, i would like some help here,

i have rearranged the code below so as to spellnumber but the result doesnot in AutoCAD

The problem is, in excel it works normally as you can see in the image attached but in AutoCAD he gives me error Run-time error 5: Invalid procedure.

down first is the working image in microsoft excel

 

 

 

spell.JPG

 

Now i leave the code, (He spells the numbers in portuguese) so an error is occuring as i have mentioned before

 

Public Function ConverterParaExtenso7(NumeroParaConverter As String) As String
Dim sExtensoFinal As String, sExtensoAtual As String
Dim i As Integer
Dim iQtdGrupos As Integer
Dim sDecimais As String
Dim sMoedaSing As String, sMoedaPlu As String, sCentavos As String
Dim bSufMoeda As Boolean

'Separa os Decimais
If InStr(1, NumeroParaConverter, ",") > 0 Then
sDecimais = Right(NumeroParaConverter, Len(NumeroParaConverter) - InStr(1, NumeroParaConverter, ","))
NumeroParaConverter = Mid(NumeroParaConverter, 1, InStr(1, NumeroParaConverter, ",") - 1)
End If

'Obtém a separação de milhares
iQtdGrupos = Fix(Len(NumeroParaConverter) / 3)
If Len(NumeroParaConverter) Mod 3 > 0 Then
iQtdGrupos = iQtdGrupos + 1
End If

'Chama as funções para escrever o número
If iQtdGrupos > 2 Then bSufMoeda = True

For i = iQtdGrupos To 1 Step -1
sExtensoAtual = DesmembraValor(NumeroParaConverter, i)
If i = 1 Then
If sExtensoAtual = "" Then
sExtensoFinal = sExtensoFinal & sExtensoAtual
Else
If sExtensoFinal = "" Then
sExtensoFinal = sExtensoFinal & sExtensoAtual
Else
sExtensoFinal = sExtensoFinal & " " & sExtensoAtual
End If
End If
Else
sExtensoFinal = sExtensoFinal & sExtensoAtual
End If

If iQtdGrupos > 2 Then
Select Case i
Case 1, 2
If sExtensoAtual <> "" Then
bSufMoeda = False
End If
End Select
End If
Next i

'Define a moeda
sMoedaPlu = ""
sMoedaSing = ""

If bSufMoeda = True Then sMoedaPlu = " de "

'Escreve os Centavos
sCentavos = EscreveCentavos(sDecimais)

'Adiciona a moeda e os centavos
sExtensoFinal = IIf((sExtensoFinal = ""), "", sExtensoFinal & IIf((sExtensoFinal = "um"), sMoedaSing, sMoedaPlu)) _
& IIf((sExtensoFinal = ""), sCentavos, IIf((sCentavos = ""), "", " virgula " & sCentavos))

'retorna o resultado
ConverterParaExtenso7 = sExtensoFinal

End Function

Private Function DesmembraValor(sValor As String, iGrupoDiv As Integer) As String
Dim iValor As Integer
Dim sExtenso As String
Dim iDivResto As Integer
Dim iDivInteiro As Integer
Dim iPosInicMid As Integer
Dim iTamMid As Integer
Dim sComplemento As String
Dim vArrDez1 As Variant
Dim vArrDez2 As Variant
Dim vArrCentena As Variant

vArrDez1 = Array("", "um", "dois", "três", "quatro", "cinco", "seis", "sete", "oito", "nove", _
"dez", "onze", "doze", "treze", "quatorze", "quinze", "dezesseis", "dezessete", _
"dezoito", "dezenove")

vArrDez2 = Array("vinte", "trinta", "quarenta", "cinquenta", "sessenta", _
"setenta", "oitenta", "noventa")

vArrCentena = Array("cem", "cento", "duzentos", "trezentos", "quatrocentos", _
"quinhentos", "seiscentos", "setecentos", "oitocentos", "novecentos")

'Pega o Valor a ser escrito e desmembra para o grupo numérico correto
iPosInicMid = Len(sValor) - ((3 * iGrupoDiv) - 1)
If iPosInicMid <= 1 Then
iTamMid = 2 + iPosInicMid
Else
iTamMid = 3
End If

If iPosInicMid < 1 Then iPosInicMid = 1

iValor = CInt(Mid(sValor, iPosInicMid, iTamMid))

Select Case iGrupoDiv
Case 2
sComplemento = " mil"
Case 3
If iValor = 1 Then
sComplemento = " milhão"
Else
sComplemento = " milhões"
End If
Case 4
If iValor = 1 Then
sComplemento = " bilhão"
Else
sComplemento = " bilhões"
End If
Case 5
If iValor = 1 Then
sComplemento = " trilhão"
Else
sComplemento = " trilhões"
End If
End Select

Select Case iValor
Case 0 To 19
sExtenso = vArrDez1(iValor)
Case 20 To 99
iDivInteiro = Fix(iValor / 10)
iDivResto = iValor Mod 10

If iDivResto = 0 Then
sExtenso = vArrDez2(iDivInteiro - 2)
Else
sExtenso = vArrDez2(iDivInteiro - 2) & " e " & vArrDez1(iDivResto)
End If
Case 100 To 999
iDivInteiro = Fix(iValor / 100)
iDivResto = iValor Mod 100

If iDivResto = 0 Then
If iDivInteiro = 1 Then
sExtenso = vArrCentena(0) 'Cem
Else
sExtenso = vArrCentena(iDivInteiro) 'inteiro maior que 100
End If
Else
sExtenso = vArrCentena(iDivInteiro) & " e "
Select Case iDivResto
Case 0 To 19
sExtenso = sExtenso & vArrDez1(iDivResto)
Case 20 To 99
iDivInteiro2 = Fix(iDivResto / 10)
iDivResto2 = iDivResto Mod 10

If iDivResto2 = 0 Then
sExtenso = sExtenso & vArrDez2(iDivInteiro2 - 2)
Else
sExtenso = sExtenso & vArrDez2(iDivInteiro2 - 2) & " e " & vArrDez1(iDivResto2)
End If
End Select
End If

End Select

DesmembraValor = sExtenso & IIf(iValor > 0, sComplemento, "")
End Function

Private Function EscreveCentavos(sCent As String) As String
Dim sExtenso As String
Dim iDivResto As Integer
Dim iDivInteiro As Integer
Dim sComplemento As String
Dim vArrDez1 As Variant
Dim vArrDez2 As Variant
Dim iCent As Integer

vArrDez1 = Array("", "um", "dois", "três", "quatro", "cinco", "seis", "sete", "oito", "nove", _
"dez", "onze", "doze", "treze", "quatorze", "quinze", "dezesseis", "dezessete", _
"dezoito", "dezenove")

vArrDez2 = Array("vinte", "trinta", "quarenta", "cinquenta", "sessenta", _
"setenta", "oitenta", "noventa")

'Adequando para duas casas decimais
iCent = Fix(sCent & String(2 - Len(sCent), "0"))

'Escrevendo Singular ou plural
If iCent = 1 Then
sComplemento = ""
Else
sComplemento = ""
End If

'Calculando os valores
Select Case iCent
Case 0 To 19
sExtenso = vArrDez1(iCent)
Case 20 To 99
iDivInteiro = Fix(iCent / 10)
iDivResto = iCent Mod 10

If iDivResto = 0 Then
sExtenso = vArrDez2(iDivInteiro - 2)
Else
sExtenso = vArrDez2(iDivInteiro - 2) & " e " & vArrDez1(iDivResto)
End If
End Select

EscreveCentavos = IIf(iCent > 0, sExtenso & sComplemento, "")
End Function

 

 

 

Rosario Dilo

Regards

 

 

 

0 Likes
Accepted solutions (2)
2,282 Views
14 Replies
Replies (14)
Message 2 of 15

Anonymous
Not applicable

what line of your code is throwing that error? (click "Debug" button in the error dialog box to see that highlighted), and with which input string?

 

in the meanwhile you could check for what decimal separator convention is adopted in your AutoCAD VBA

0 Likes
Message 3 of 15

ramd401
Advocate
Advocate

Hi @Anonymous iam receaving errors in these two lines showed in the attached images

 

first error.JPG

 

 

 

 

 

 

 

second error.JPG

 

Rosario Dilo

Regards

0 Likes
Message 4 of 15

Anonymous
Not applicable

please answer all questions in proper detail

1) with reference to your last post first screenshot: what error is throwing and with what input string?

2) with reference to your last post second screenshot: what input string lead to the error?

3) have you made your mind up about decimal separator?

   you could place a break point at 

If InStr(1, NumeroParaConverter, ",") > 0 Then

 then, when hitting that break point query immediate window with 

?NumeroParaConverter, CDbl(NumeroParaConverter)

and see if both returned values fit your expectations

 

0 Likes
Message 5 of 15

ramd401
Advocate
Advocate

Hi @Anonymous

 

1 ) with the reference of last post, first screnshot the error is (Run-time error `5` , Invalid procedure call or argument)

2 ) secong screnshot the string error is (sDecimais) if i omite this lines it works but can not give the the decimal spelling

3 ) can you indicate me in wich line i can put the break point and how? cause i had not made my mind up decimal separator

 

 

0 Likes
Message 6 of 15

Anonymous
Not applicable

what is the number you wanted to spell and passed as "NumeroParaConverter" argument to ConverterParaExtenso7() function?

0 Likes
Message 7 of 15

ramd401
Advocate
Advocate

Hi, @Anonymous i would like you to test the script and see exactly the errors and corect that, you can after teste this number 3.456,24  so the spelling in portuguese is: três mil quatrocentos e cinquenta e seis virgula vinte e quatro.

 

 

Rosario Dilo 

Regards

 

0 Likes
Message 8 of 15

Anonymous
Not applicable

running the following sub:

Sub main()
    Debug.Print ConverterParaExtenso7("3.456,24")
End Sub

it returns 

três mil quatrocentos e cinquenta e seis virgula vinte e quatro

with no error

 

the same happens with: 

Debug.Print ConverterParaExtenso7("3456,24")

while if I try:

Debug.Print ConverterParaExtenso7("3456.24")

it throws a "Run-time error '13': Type mismatch" error at code line

iValor = CInt(Mid(sValor, iPosInicMid, iTamMid))

 

 

0 Likes
Message 9 of 15

ramd401
Advocate
Advocate

Hi @Anonymous so this is not the point (to convert only a number).

I really need the full script to convert any number he finds as it is happening in excel,

Look, the atached image represents my userform, when i click "Área e perimetro" he asks me to select a polyline and after he gives this result in the first textbox so the second textbox  has to spell the number from the first one, so, there is where i find this errors.

So what i need is to see the script be able to spell normally any number as it is happening in access, i only right anymumber in a cell and it spells that

 

get area.JPG

0 Likes
Message 10 of 15

Anonymous
Not applicable
Well, your first post was about some error in the attached code
And I told you your code was running correctly as long as decimal points are properly input

Now you are talking about some "full script" and a Userform

So:
- is the original issue of this thread ("error Run-time error 5: Invalid procedure") solved?
If so, please mark my answer as the solution ans open a new thread to face any new issue (like any Userfom one) toghether with all the code needed

If not (your attached code is still throwing error in the way of spelling a number) post the very conditions under which it does so, showing the code that is calling ConverterParaExtenso7() as well (and some effort on your part, too ...)



0 Likes
Message 11 of 15

ramd401
Advocate
Advocate

Hi @Anonymous as i have told, the problem are the lines i have mentioned, if i clean them it spells but without the decimals, iam not so expert yet in vba, i have already done many modifications but did not work so, i woul like an ideia like, replace the line x by this and that, iam still continuing also see what to correct.

Rosário Dilo - regards

0 Likes
Message 12 of 15

Anonymous
Not applicable
I cannot but repeat myself

"If not (your attached code is still throwing error in the way of spelling a number) post the very conditions under which it does so, showing the code that is calling ConverterParaExtenso7() as well"

If you don't provide all what aboce I'm unable to help you further
0 Likes
Message 13 of 15

ramd401
Advocate
Advocate

Hi @Anonymous

the first textbox is textbox50 where i get the number to be converted

the second text box is textbox70 where i try to spell the number.

To send the text to be spelled in text box 70 iam using the following code in text box50:

 

 

Private Sub TextBox50_Change()
TextBox70.Text = ConverterParaExtenso(TextBox50.Text)
End Sub

0 Likes
Message 14 of 15

Anonymous
Not applicable
Accepted solution

you make it hard to help you

I'm nearly begging you for a real and complete example that throws that error and you're giving details bit after bit

 

anyhow, taking the "daily bit" into account I cannot but remind you to make your mind up about the decimal separator issue

so:

 

- what's the actual TextBox50.Text string that's being passed to ConverterParaExtenso() sub?

  may be it has some dot (".") separator that isn't recognized as such by your ConverterParaExtenso() sub

  in this case you may want to treat that string before passing to your sub, like for instance:

  

TextBox70.Text = ConverterParaExtenso(Replace(TextBox50.Text,".",",") '<--| substitute the "dot" decimal separator with a "comma" one

 

 

- how many decimal is your ConverterParaExtenso() sub able to handle?

  may be it's able to handle up to two decimals

  in this case you may want to enhance the treatment of the string to pass to your sub, like for instance:

TextBox70.Text = ConverterParaExtenso(round(Replace(TextBox50.Text,".",",") ,2)) '<--| round to two decimals

 

I'm quite sure that if you play a little bit with what above, with some small "trial and error" activity you should come to the solution

0 Likes
Message 15 of 15

ramd401
Advocate
Advocate
Accepted solution

Now i have got it like this and it works

 

Private Sub TextBox50_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox70.Text = ConverterParaExtenso(TextBox50.Text)
End Sub

 

thanks for all

0 Likes