Boa tarde pessoal .Achei esta macro na internet mas esta dando erro e não consigo aplica-la , alguem poderia me ajudar corrigindo ela para que funcione. grato

Public Function ConverterParaExtenso(rngNumeroParaConverter As Range) 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
Dim NumeroParaConverter As String
    Application.Volatile
    'Obtém o valor para converter para extenso
    NumeroParaConverter = rngNumeroParaConverter.Value

    '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 & " e " & 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
    If InStr(1, rngNumeroParaConverter.NumberFormat, "$$") > 0 Then        'Dolar
        sMoedaPlu = " dólares"
        sMoedaSing = " dólar"
        If bSufMoeda = True Then sMoedaPlu = " de dólares"
    ElseIf InStr(1, rngNumeroParaConverter.NumberFormat, "€") > 0 Then     'Euro
        sMoedaPlu = " euros"
        sMoedaSing = " euro"
        If bSufMoeda = True Then sMoedaPlu = " de euros"
    Else                                                                   'Reais
        sMoedaPlu = " reais"
        sMoedaSing = " real"
        If bSufMoeda = True Then sMoedaPlu = " de reais"
    End If

    'Escreve os Centavos
    sCentavos = EscreveCentavos(sDecimais)

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

    'retorna o resultado
    ConverterParaExtenso = 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  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 = " centavo"
    Else
        sComplemento = " centavos"
    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