[Resolvido]Valor por extenso mas com Primeira letra maiúscula

mais um pedido de ajuda aos amigos do Forum, tenho um modulo Extenso 95 funciona certinho mas preciso de que seja a primeira letra maiúscula não consegui resolver agradeço quem puder me ajudar. !

Olá Nogaro!

Da uma olhada

Saludos

Olá Carlos

Função Extenso retornando o valor com a primeira letra maiúscula:

Código:


Function Extenso(nValor As String) As String

'Faz a validação do argumento
If IsNull(nValor) Or nValor > 999999999.99 Then Exit Function

'Declara as variáveis da função
Dim intContador As Integer
Dim intTamanho As Integer
Dim strValor As String
Dim strParte As String
Dim strFinal As String
Dim strGrupo(4) As String
Dim strTexto(4) As String

'Define matrizes com extensos parciais
Dim strUnid(19) As String
strUnid(1) = "um ": strUnid(2) = "dois ": strUnid(3) = "três ": strUnid(4) = "quatro ": strUnid(5) = "cinco ": strUnid(6) = "seis ": strUnid(7) = "sete ": strUnid( = "oito ": strUnid(9) = "nove ": strUnid(10) = "dez ": strUnid(11) = "onze ": strUnid(12) = "doze ": strUnid(13) = "treze ": strUnid(14) = "quatorze ": strUnid(15) = "quinze ": strUnid(16) = "dezesseis ": strUnid(17) = "dezessete ": strUnid(18) = "dezoito ": strUnid(19) = "dezenove "
Dim strDezena(9) As String
strDezena(1) = "dez ": strDezena(2) = "vinte ": strDezena(3) = "trinta ": strDezena(4) = "quarenta ": strDezena(5) = "cinqüenta ": strDezena(6) = "sessenta ": strDezena(7) = "setenta ": strDezena( = "oitenta ": strDezena(9) = "noventa "
Dim strCentena(9) As String
strCentena(1) = "cento ": strCentena(2) = "duzentos ": strCentena(3) = "trezentos ": strCentena(4) = "quatrocentos ": strCentena(5) = "quinhentos ": strCentena(6) = "seiscentos ": strCentena(7) = "setecentos ": strCentena( = "oitocentos ": strCentena(9) = "novecentos "

'Divide o valor em vários grupos
strValor = Format$(nValor, "0000000000.00")
strGrupo(1) = Mid$(strValor, 2, 3) 'Milhão
strGrupo(2) = Mid$(strValor, 5, 3) 'Milhar
strGrupo(3) = Mid$(strValor, 8, 3) 'Centena
strGrupo(4) = "0" + Mid$(strValor, 12, 2) 'Centavo

'Processa cada grupo
For intContador = 1 To 4
    strParte = strGrupo(intContador)

    intTamanho = Switch(Val(strParte) < 10, 1, Val(strParte) < 100, 2, Val(strParte) < 1000, 3)
    If intTamanho = 3 Then
       If Right$(strParte, 2) <> "00" Then
          strTexto(intContador) = strTexto(intContador) + strCentena(Left(strParte, 1)) + "e "
          intTamanho = 2
       Else
          strTexto(intContador) = strTexto(intContador) + IIf(Left$(strParte, 1) = "1", "cem ", strCentena(Left(strParte, 1)))
       End If
    End If

    If intTamanho = 2 Then
       If Val(Right(strParte, 2)) < 20 Then
          strTexto(intContador) = strTexto(intContador) + strUnid(Right(strParte, 2))
       Else
          strTexto(intContador) = strTexto(intContador) + strDezena(Mid(strParte, 2, 1))
          If Right$(strParte, 1) <> "0" Then
             strTexto(intContador) = strTexto(intContador) + "e "
             intTamanho = 1
          End If
       End If
    End If

    If intTamanho = 1 Then
       strTexto(intContador) = strTexto(intContador) + strUnid(Right(strParte, 1))
    End If
Next intContador

'Gera o formato final do texto
If Val(strGrupo(1) + strGrupo(2) + strGrupo(3)) = 0 And Val(strGrupo(4)) <> 0 Then
   strFinal = strTexto(4) + IIf(Val(strGrupo(4)) = 1, "centavo de real", "centavos de reais")
Else
   strFinal = ""
   If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) = 0 Then
      strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões de ", "milhão de "), "")
   End If
   If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) = 0 Then
      strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões e ", "milhão e "), "")
   End If
   If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) = 0 Then
      strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões e ", "milhão e "), "")
   End If
   If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) = 0 Then
      strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões, ", "milhão, "), "")
   End If
   If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) <> 0 Then
       strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões, ", "milhão, "), "")
   End If
   If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) <> 0 Then
      strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões, ", "milhão, "), "")
   End If
   If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) <> 0 Then
      strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões de ", "milhão de "), "")
   End If
   If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) <> 0 Then
      strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões, ", "milhão, "), "")
   End If
   If Val(strGrupo(3)) = 0 Then
      strFinal = strFinal + IIf(Val(strGrupo(2)) <> 0, strTexto(2) + "mil ", "")
   Else
      If Val(strGrupo(4)) = 0 Then
         strFinal = strFinal + IIf(Val(strGrupo(2)) <> 0, strTexto(2) + "mil e ", "")
      Else
         strFinal = strFinal + IIf(Val(strGrupo(2)) <> 0, strTexto(2) + "mil, ", "")
      End If
   End If
   If Val(strGrupo(4)) = 0 Then
      strFinal = strFinal + strTexto(3) + IIf(Val(strGrupo(1) + strGrupo(2) + strGrupo(3)) = 1, "real ", "reais ")
   Else
      strFinal = strFinal + strTexto(3) + IIf(Val(strGrupo(3)) <> 1, IIf(Val(strGrupo(1) + strGrupo(2) + strGrupo(3)) = 1, "real ", "reais "), "real ")
   End If
   strFinal = strFinal + IIf(Val(strGrupo(4)) <> 0, "e " + strTexto(4) + IIf(Val(strGrupo(4)) = 1, "centavo", "centavos"), "")
End If
If Left(strFinal, 1) = "u" Then
   Extenso = "H" & Mid$(strFinal, 1)
Else
   Extenso = UCase(Mid$(strFinal, 1, 1)) & Mid$(strFinal, 2)
End If
End Function



Uso:

UCase(Left(Extenso(NomeDaCaixaDeTexto),1)) & Mid(Extenso(NomeDaCaixaDeTexto),2)

{ }'s


Balem

obrigado Balem pela ajuda mas não consegui adaptar o código de uso e onde colocar  !

o exemplo do amigo  Franklin primeira letra em maiúscula mas sem valor por extenso  exemplo R$ 120,00 = Cento e Vinte Reais.

coloquei em um campo da consulta txtextenso ([txtValor])

obrigado Balem e Franklin

Ótimo!
Que bom que deu certo Carlos

Boa sorte!

Balem