Tenho uma rotina que imprime um valor (monetário) por extenso. Porém, preciso imprimir esse valor por extenso em uma duplicata. Só que pode acontecer de o valor por extenso não caber em uma linha. Preciso que ao imprimir o valor por extenso, quando chegar no final da linha, continue imprimindo na próxima linha até chegar ao final da impressão. Alguém conhece uma rotina que faça isso?

 

Até mais.

Caro Xando , eu uso assim :

Primeiro a funçao que uso abaixo

intCharLinha1 = 60

intCharLinha2 = 60

 

strExtenso = Trim(UCase(Extenso(dblVlrCheque, "REAIS", "REAL")))
If Len(strExtenso) > intCharLinha1 Then
                      For x = intCharLinha1 To 1 Step -1
                         If Mid(strExtenso, x, 1) = " " Then
                            strTexto2 = Mid(strExtenso, 1, x) & String(intCharLinha1 - Len(Mid(strExtenso, 1, x)), "*")
                            strTexto3 = Mid(strExtenso, x + 1, Len(strExtenso)) & String(intCharLinha2 - Len(Mid(strExtenso, x + 1, Len(strExtenso))), "*")
                            Exit For
                         End If
                      Next
                    Else
                      strTexto2 = strExtenso & String(intCharLinha1 - Len(strExtenso), "*")
                      strTexto3 = String$(intCharLinha2, "*")
                    End If
                   
                    'Linha 1
                    Printer.CurrentY = dblAcuLinha1
                    Printer.CurrentX = dblColExt1      

                    Printer.Print strTexto2
                    'Linha 2
                    Printer.CurrentY = dblAcuLinha2
                    Printer.CurrentX = dblColExt1       

                    Printer.Print strTexto3

 

Public Function Extenso(ByVal Valor As _
    Double, ByVal MoedaPlural As _
    String, ByVal MoedaSingular As _
    String) As String
   
    'P/ chamar a função:
    'Dim sRet As String
    'Dim dValor As Double
    'dValor = 88889.88
    'sRet = Extenso(dValor, "Reais", "Real")
    'MsgBox sRet
   
    Dim StrValor As String, Negativo As Boolean
    Dim Buf As String, Parcial As Integer
    Dim posicao As Integer, Unidades
    Dim Dezenas, Centenas, PotenciasSingular
    Dim PotenciasPlural
   
    Negativo = (Valor < 0)
    Valor = Abs(CDec(Valor))
    If Valor Then
      Unidades = Array(vbNullString, "Um", "Dois", _
                 "Tres", "Quatro", "Cinco", _
                 "Seis", "Sete", "Oito", "Nove", _
                 "Dez", "Onze", "Doze", "Treze", _
                 "Quatorze", "Quinze", "Dezesseis", _
                 "Dezessete", "Dezoito", "Dezenove")
      Dezenas = Array(vbNullString, vbNullString, _
                "Vinte", "Trinta", "Quarenta", _
                "Cinquenta", "Sessenta", "Setenta", _
                "Oitenta", "Noventa")
      Centenas = Array(vbNullString, "Cento", _
                 "Duzentos", "Trezentos", _
                 "Quatrocentos", "Quinhentos", _
                 "Seiscentos", "Setecentos", _
                 "Oitocentos", "Novecentos")
      PotenciasSingular = Array(vbNullString, " Mil", _
                          " Milhao", " Bilhao", _
                          " Trilhao", " Quatrilhao")
      PotenciasPlural = Array(vbNullString, " Mil", _
                        " Milhoes", " Bilhoes", _
                        " Trilhoes", " Quatrilhoes")
   
      StrValor = Left(Format(Valor, String(18, "0") & _
                 ".000"), 18)
      For posicao = 1 To 18 Step 3
        Parcial = Val(Mid(StrValor, posicao, 3))
        If Parcial Then
          If Parcial = 1 Then
            Buf = "Um" & PotenciasSingular((18 - _
                  posicao)  3)
          ElseIf Parcial = 100 Then
            Buf = "Cem" & PotenciasSingular((18 - _
                  posicao)  3)
          Else
            Buf = Centenas(Parcial  100)
            Parcial = Parcial Mod 100
            If Parcial <> 0 And Buf <> vbNullString Then
              Buf = Buf & " e "
            End If
            If Parcial < 20 Then
              Buf = Buf & Unidades(Parcial)
            Else
              Buf = Buf & Dezenas(Parcial  10)
              Parcial = Parcial Mod 10
              If Parcial <> 0 And Buf <> vbNullString Then
                Buf = Buf & " e "
              End If
              Buf = Buf & Unidades(Parcial)
            End If
            Buf = Buf & PotenciasPlural((18 - posicao)  3)
          End If
          If Buf <> vbNullString Then
            If Extenso <> vbNullString Then
              Parcial = Val(Mid(StrValor, posicao, 3))
              If posicao = 16 And (Parcial < 100 Or _
                  (Parcial Mod 100) = 0) Then
                Extenso = Extenso & " e "
              Else
                Extenso = Extenso & ", "
              End If
            End If
            Extenso = Extenso & Buf
          End If
        End If
      Next
      If Extenso <> vbNullString Then
        If Negativo Then
          Extenso = "Menos " & Extenso
        End If
        If Int(Valor) = 1 Then
          Extenso = Extenso & " " & MoedaSingular
        Else
          Extenso = Extenso & " " & MoedaPlural
        End If
      End If
      Parcial = Int((Valor - Int(Valor)) * _
                100 + 0.1)
      If Parcial Then
        Buf = Extenso(Parcial, "Centavos", _
              "Centavo")
        If Extenso <> vbNullString Then
          Extenso = Extenso & " e "
        End If
        Extenso = Extenso & Buf
      End If
    End If
End Function