Sub UnderLineText(ByRef InText As Range)
  InText.Formula = CStr(InText.Value)  ' converts result of formula into a string literal
    'or: InText.offset(0,1).formula = cstr(InText.value) -- writes the value in the cell next to InText
  InText.Characters(1, 5).Font.Underline = True
  UnderLineText = InText
End Sub
Function SpellNumberToPortuguese(ByVal pNumber)
'Updateby20131113
Dim Euros, Cents
arr = Array("", "", " Mil ", " Milhões ", " Mil Milhões ", " Bilhões")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
    Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
    pNumber = Trim(Left(pNumber, xDecimal - 1))
End If
xIndex = 1
Do While pNumber <> ""
    xHundred = ""
    XValue = Right(pNumber, 3)
    If Val(XValue) <> 0 Then
        XValue = Right("000" & XValue, 3)
        If Mid(XValue, 1, 1) <> "0" Then
            xHundred = GetHundreds(Mid(XValue, 1))
        ElseIf Mid(XValue, 2, 1) <> "0" Then
            xHundred = GetTens(Mid(XValue, 2))
        ElseIf Mid(XValue, 3, 1) <> "0" Then
            xHundred = GetDigit(Mid(XValue, 3))
        End If
    End If
    If xHundred <> "" Then
        Euros = xHundred & arr(xIndex) & Euros
    End If
    If Len(pNumber) > 3 Then
        pNumber = Left(pNumber, Len(pNumber) - 3)
    Else
        pNumber = ""
    End If
    xIndex = xIndex + 1
Loop
Select Case Euros
    Case ""
        Euros = "No Euros"
    Case "One"
        Euros = "One Euro"
    Case Else
        Euros = Euros & " Euros"
End Select
Select Case Cents
    Case ""
        Cents = " e Zero Cêntimos"
    Case "One"
        Cents = " e um Cêntimo"
    Case Else
        Cents = " e " & Cents & " Cêntimos"
End Select
SpellNumberToPortuguese = Euros & Cents
End Function
Function GetHundreds(pNumber)
Dim Result As String
Dim pHundreds As String
pHundreds = Mid(pNumber, 1, 1)
Result = ""

If pHundreds = "-" Then
    Result = "Menos "
    If Mid(pNumber, 2, 1) <> "0" Then
        Result = Result & GetTens(Mid(pNumber, 2))
    ElseIf Right(pNumber, 1) <> "0" Then
        Result = Result & GetDigit(Right(pNumber, 1))
    End If
    GetHundreds = Result
    Exit Function
End If

If pHundreds = "1" And (Mid(pNumber, 2, 1) <> "0" Or Mid(pNumber, 3, 1) <> "0") Then
    Result = "Cento"
Else
    Select Case Val(pHundreds)
        Case 1: Result = "Cem"
        Case 2: Result = "Duzentos"
        Case 3: Result = "Trezentos"
        Case 4: Result = "Quatrocentos"
        Case 5: Result = "Quinhentos"
        Case 6: Result = "Seiscentos"
        Case 7: Result = "Setecentos"
        Case 8: Result = "Oitocentos"
        Case 9: Result = "Novecentos"
        Case Else: Result = ""
    End Select
End If
If Mid(pNumber, 2, 1) <> "0" Then
    Result = Result & " e " & GetTens(Mid(pNumber, 2))
ElseIf Right(pTens, 1) <> "0" Then
    Result = Result & " e " & GetDigit(Right(pNumber, 1))
End If
GetHundreds = Result
End Function
Function GetTens(pTens)
Dim Result As String
Result = ""

If pHundreds = "-" Then
    Result = "Menos"
    Exit Function
End If

If Val(Left(pTens, 1)) = 1 Then
    Select Case Val(pTens)
        Case 10: Result = "Dez"
        Case 11: Result = "Onze"
        Case 12: Result = "Doze"
        Case 13: Result = "Treze"
        Case 14: Result = "Catorze"
        Case 15: Result = "Quinze"
        Case 16: Result = "Desasseis"
        Case 17: Result = "Dezassete"
        Case 18: Result = "Dezoito"
        Case 19: Result = "Dezanove"
        Case Else
    End Select
Else
Select Case Val(Left(pTens, 1))
    Case 2: Result = "Vinte"
    Case 3: Result = "Trinta"
    Case 4: Result = "Quarenta"
    Case 5: Result = "Cinquenta"
    Case 6: Result = "Sessenta"
    Case 7: Result = "Setenta"
    Case 8: Result = "Oitenta"
    Case 9: Result = "Noventa"
    Case Else
End Select
If Val(Right(pTens, 1)) > 0 Then
Result = Result & " e " & GetDigit(Right(pTens, 1))
End If
End If
GetTens = Result
End Function
Function GetDigit(pDigit)

If pHundreds = "-" Then
    Result = "Menos"
    Exit Function
End If

Select Case Val(pDigit)
    Case 1: GetDigit = "Um"
    Case 2: GetDigit = "Dois"
    Case 3: GetDigit = "Três"
    Case 4: GetDigit = "Quatro"
    Case 5: GetDigit = "Cinco"
    Case 6: GetDigit = "Seis"
    Case 7: GetDigit = "Sete"
    Case 8: GetDigit = "Oito"
    Case 9: GetDigit = "Nove"
    Case Else: GetDigit = ""
End Select
End Function