Ocultando e reexibindo barras de ferramentas do Excel

Abra o excel, entre no editor de VBA , alt+f11, insira um módulo e copie o
código abaixo;

Sub Ocultar()
Dim barras
For Each barras In Application.CommandBars

barras.Enabled = False

Next
Application.DisplayFullScreen
= True
ActiveWindow.DisplayHeadings = False

Application.DisplayFormulaBar = False

ActiveWindow.DisplayHorizontalScrollBar = False

ActiveWindow.DisplayVerticalScrollBar = False

ActiveWindow.DisplayWorkbookTabs = False


End Sub

Sub Reexibir()
Dim barras
Application.EnableCancelKey =
xlDisabled
On Error Resume Next
For Each barras In
Application.CommandBars

barras.Enabled = True
Next

Application.DisplayFormulaBar = True

Application.DisplayFullScreen = False

ActiveWindow.DisplayHeadings = True

ActiveWindow.DisplayHorizontalScrollBar = True

ActiveWindow.DisplayVerticalScrollBar = True

ActiveWindow.DisplayWorkbookTabs = True


End Sub

** Obs. Este código de ocultar as barras pode ser colocado também em
EstaPasta_de_trabalho para que quando inicializado seu arquivo de excel o mesmo
já oculte as barras.**

Função valor em extenso para excel

Abra o excel, entre no editor do VBA alt + f11, insira um módulo e copie o
código abaixo. Após feito isso, feche o editor do VBA e insira a função
"extenso" em uma célula da sua planilha. A partir dai é só inserir os números e
você terá o escrito do valor digitado.

Function extenso(nValor As String) As String

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(8) = "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(8) = "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(8) = "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", "centavos")
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
Dim aux As String
* 150
aux = Trim(extenso) ' e alterar esta
linha para trim(extenso)
While Len(Trim(aux)) <> 150
aux =
Trim(aux) & "-$"
Wend
extenso = aux

End Function

Colorindo células através de VBA

Às vezes não queremos que outras pessoas alterem as cores de formatação de uma planilha.

Além de proteger existem outras maneiras para impedir. Abaixo você tem uma forma simples de colorir fonte e interior das células.

Entre no no editor de macros alt + f11, em estapasta_de_trabalho e cole o código abaixo:

Private Sub Workbook_Open()
Worksheets("plan1").Range("a1").Font.ColorIndex = 1 ' onde na planilha 1, celula a1 a corde fonte será = 1 que representa o preto
Worksheets("plan1").Range("A1").interior.ColorIndex = 3 ' onde na planilha 1, celula a1 o interior (a cor da celula) será = 3 que representa o vermelho
end sub

Existem muitas maneiras de se formatar células do Excel, este foi um exemplo de como é simples e interessante usarmos o editor de VBA.

Verificação de CPF E CNPJ

Muitas pessoas se perguntam como verificar se um CPF OU CGC (antigo CNPJ) são validos. Abaixo ensinamos como verificar esses dados.
Abra o Excel entre no editor de VBA (Alt + F11) insira um módulo e cole este código:

Function CGC(CNPJ As String) As String


Dim intSoma, intSoma1, intSoma2, intInteiro As Long
Dim intNumero, intMais, i, intResto As Integer
Dim intDig1, intDig2 As Integer
Dim strcampo, strCaracter, StrConf, strCNPJ, strDigVer As String
Dim dblDivisao As Double
intSoma = 0
intSoma1 = 0
intSoma2 = 0
intNumero = 0
intMais = 0


strDigVer = Right(CNPJ, 2)
strcampo = Left(CNPJ, 8)
strCNPJ = Right(CNPJ, 6)
strCNPJ = Left(strCNPJ, 4)
strcampo = Right(strcampo, 4) & strCNPJ

For i = 2 To 9
strCaracter = Right(strcampo, i - 1)
intNumero = Left(strCaracter, 1)
intMais = intNumero * i
intSoma1 = intSoma1 + intMais
Next i
'Separa os 4 primeiros dígitos do CGC
strcampo = Left(CNPJ, 4)
For i = 2 To 5
strCaracter = Right(strcampo, i - 1)
intNumero = Left(strCaracter, 1)
intMais = intNumero * i
intSoma2 = intSoma2 + intMais
Next i
intSoma = intSoma1 + intSoma2
dblDivisao = intSoma / 11
intInteiro = Int(dblDivisao) * 11
intResto = intSoma - intInteiro
If intResto = 0 Or intResto = 1 Then
intDig1 = 0
Else
intDig1 = 11 - intResto
End If
intSoma = 0
intSoma1 = 0
intSoma2 = 0
intNumero = 0
intMais = 0

strcampo = Left(CNPJ, 8)
strCNPJ = Right(CNPJ, 6)
strCNPJ = Left(strCNPJ, 4)
strcampo = Right(strcampo, 3) & strCNPJ & intDig1

For i = 2 To 9
strCaracter = Right(strcampo, i - 1)
intNumero = Left(strCaracter, 1)
intMais = intNumero * i
intSoma1 = intSoma1 + intMais
Next i
strcampo = Left(CNPJ, 5)
For i = 2 To 6
strCaracter = Right(strcampo, i - 1)
intNumero = Left(strCaracter, 1)
intMais = intNumero * i
intSoma2 = intSoma2 + intMais
Next i
intSoma = intSoma1 + intSoma2
dblDivisao = intSoma / 11
intInteiro = Int(dblDivisao) * 11
intResto = intSoma - intInteiro
If intResto = 0 Or intResto = 1 Then
intDig2 = 0
Else
intDig2 = 11 - intResto
End If
StrConf = intDig1 & intDig2
CGC = StrConf

End Function

Function DVCPF(Cpf As String) As String

Dim lngSoma, lngInteiro As Long
Dim intNumero, intMais, i, intResto As Integer
Dim intDig1, intDig2 As Integer
Dim strDigVer, strcampo, strCaracter, StrConf As String
Dim dblDivisao As Double
lngSoma = 0
intNumero = 0
intMais = 0

strcampo = Left(Cpf, 9)
strDigVer = Right(Cpf, 2)
For i = 2 To 10
strCaracter = Right(strcampo, i - 1)
intNumero = Left(strCaracter, 1)
intMais = intNumero * i
lngSoma = lngSoma + intMais
Next i
dblDivisao = lngSoma / 11
lngInteiro = Int(dblDivisao) * 11
intResto = lngSoma - lngInteiro
If intResto = 0 Or intResto = 1 Then
intDig1 = 0
Else
intDig1 = 11 - intResto
End If
strcampo = strcampo & intDig1
lngSoma = 0
intNumero = 0
intMais = 0
For i = 2 To 11
strCaracter = Right(strcampo, i - 1)
intNumero = Left(strCaracter, 1)
intMais = intNumero * i
lngSoma = lngSoma + intMais
Next i
dblDivisao = lngSoma / 11
lngInteiro = Int(dblDivisao) * 11
intResto = lngSoma - lngInteiro
If intResto = 0 Or intResto = 1 Then
intDig2 = 0
Else
intDig2 = 11 - intResto
End If
StrConf = intDig1 & intDig2
DVCPF = StrConf
End Function




Agora em uma das suas planilhas, pelo editor de VBA insira o codigo abaixo.
Observe a celula descrita no codigo e digite o numero do seu CPF / CGC para verificar o exemplo.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Dig, Nvar
'NVar = Celula onde deverá testar o numero de teste Format(Range("a1"), "00000000000000")
If Target.Address = Range("a1").Address Then
If IsNumeric(Range("a1")) Then 'se não preencher o campo ignora
Dig = Right(Format(Range("a1"), "00000000000000"), 2)
Nvar = Módulo1.CGC(Format(Range("a1"), "00000000000000"))
If Dig = Nvar Then
Else 'senão avisa em vermelho
Range("a1") = "CGC INVÁLIDO"
End If
End If
ElseIf Target.Address = Range("A2").Address Then
If IsNumeric(Range("A2")) Then 'se não preencher o campo ignora
Dig = Right(Format(Range("A2"), "00000000000"), 2)
Nvar = Módulo1.DVCPF(Format(Range("A2"), "00000000000"))
If Dig = Nvar Then
Else 'senão avisa em vermelho
Range("A2") = "CPF INVÁLIDO"
End If
End If
End If
End Sub

Executando um Erro Fatal no Excel

Proteja suas planilhas. Caso não seja digitada a senha correta, o seu arquivo gera um erro fatal, impedindo que outras pessoas tenham acesso.

Abra o editor do VBA insira um módulo e copie este código

**Obs. voce pode personalizar este código**



Private Declare Sub FatalAppExit Lib "kernel32" Alias "FatalAppExitA" (ByVal uAction As Long, ByVal lpMessageText As String)
Private Declare Sub FatalExit Lib "kernel32" (ByVal code As Long)

Sub Erro_Fatal_Personalizado()
senha = "acessar"
If Application.InputBox("Digite a senha autorizada", "Dicas de Excel e Vba", "acessar") = senha Then
Else
FatalAppExit 0, "ACESSO NÃO PERMITIDO, DESCULPE!"
End If
End Sub


Insira esse código em "Esta Pasta de Trabalho". Assim quando abrir a planilha será pedida a senha.

Private Sub Workbook_Open()
Call Erro_Fatal_Personalizado
End Sub

Formatação Condicional

Apesar de pouco utilizada a formatação condicional é extremamente valiosa para que procura ser "diferenciado" em excel, ela permite realçar determinados dados em nossas planilhas, veja como utiliza-la.

Alterar, adicionar ou remover formatos condicionais
1. Selecione uma célula cujos formatos condicionais você deseja alterar ou remover.
2. No menu Formatar, clique em Formatação condicional.
3. Altere o operador, os valores, a fórmula ou os formatos para cada condição.
Para alterar os formatos, clique em Formatar para a condição que você deseja modificar. Para selecionar outra vez formatos na guia atual da caixa de diálogo Formatar células, clique em Limpar.

Para adicionar uma nova condição, clique em Adicionar.

Para remover uma ou mais condições, clique em Excluir e, em seguida, marque a caixa de seleção para as condições que você deseja excluir.

Dica: Para remover todos formatos condicionais além de todos os outros formatos de célula para as células selecionadas, aponte para Limpar no menu Editar e clique em Formatos.

Função "SOMASE"

Adiciona as células especificadas por um determinado critério.

Sintaxe

SOMASE(intervalo;critérios;intervalo_soma)

Intervalo é o intervalo de células que se deseja calcular.

Critérios são os critérios na forma de um número, expressão ou texto, que define quais células serão adicionadas. Por exemplo, os critérios podem ser expressos como 32, "32", "&gt;32", "maçãs".

Intervalo_soma são as células que serão realmente somadas. As células em intervalo_soma são somadas somente se suas células correspondentes em intervalo coincidirem com os critérios estipulados. Se intervalo_soma for omitido, as células em intervalo serão somadas.

Exemplo

Suponha que A1:A4 contém os seguintes valores de propriedade para quatro casas: R$ 100.000, R$ 200.000, R$ 300.000, R$ 400.000, respectivamente. B1:B4 conterá as seguintes comissões de vendas em cada um dos valores de propriedade correspondentes: R$ 7.000, R$ 14.000, R$ 21.000, R$ 28.000.

SOMASE(A1:A4;"&gt;160000";B1:B4) é igual a R$ 63.000

Função "Cont.SE"

Calcula o número de células não vazias em um intervalo que
corresponde a determinados critérios.

Sintaxe

CONT.SE(intervalo;critérios)

Intervalo é o intervalo de células no qual se deseja
contar células não vazias.

Critérios é o critério na forma de um número,
expressão ou texto que define quais células serão contadas. Por exemplo, os
critérios podem ser expressos como 32, "32", "&gt;32", "maçãs".

Exemplos

Suponha que A3:A6 contenha "maçãs", "laranjas", "pêras",
"maçãs", respectivamente.

CONT.SE(A3:A6;"maçãs") é igual a
2

Suponha que B3:B6 contenha 32, 54, 75, 86,
respectivamente.

CONT.SE(B3:B6;"&gt;55") é igual a
2

Função "SE"

Retorna um valor se uma condição que você especificou avaliar
como VERDADEIRO e um outro valor se for avaliado como FALSO.

Use SE para conduzir testes condicionais sobre valores e
fórmulas.

Sintaxe

SE(teste_lógico;valor_se_verdadeiro;valor_se_falso)

Teste_lógico é qualquer valor ou expressão que
possa ser avaliado como VERDADEIRO ou FALSO. Por exemplo, A10=100 é uma
expressão lógica; se o valor da célula A10 for igual a 100, a expressão será
considerada VERDADEIRA. Caso contrário, a expressão será considerada FALSA. Esse
argumento pode usar qualquer operador de cálculo de comparação.

Valor_se_verdadeiro é o valor retornado se
teste_lógico for VERDADEIRO. Por exemplo, se esse argumento for a sequência de
caracteres de texto "Dentro do orçamento" e o argumento teste_lógico for
considerado VERDADEIRO, a função SE exibirá o texto "Dentro do orçamento". Se
teste_lógico for VERDADEIRO e valor_se_verdadeiro for vazio, o argumento
retornará 0 (zero). Para exibir a palavra VERDADEIRO, use o valor lógico
VERDADEIRO para esse argumento. Valor_se_verdadeiro pode ser outra
fórmula.

Valor_se_falso é o valor retornado se teste_lógico
for FALSO. Por exemplo, se esse argumento for a sequência de caracteres de texto
"Acima do orçamento" e o argumento teste_lógico for considerado FALSO, a função
SE exibirá o texto "Acima do orçamento". Se teste_lógico for FALSO e
valor_se_falso for omitido (ou seja, se não houver vírgula após
valor_se_verdadeiro), o valor lógico FALSO será retornado. Se teste_lógico for
FALSO e valor_se_falso for vazio (ou seja, se houver uma vírgula após
valor_se_verdadeiro seguida do parênteses de fechamento), o valor 0 (zero) será
retornado. Valor_se_falso pode ser outra fórmula.

Comentários

• Até sete funções SE podem ser aninhadas como argumentos
  valor_se_verdadeiro e valor_se_falso para construir testes mais elaborados.
  Consulte o último exemplo a seguir.
  
  
• Quando os argumentos valor_se_verdadeiro e valor_se_falso são
  avaliados, SE retorna o valor que foi retornado por estas
  instruções.
  
  
• Se qualquer um dos argumentos de SE forem matrizes, cada
  elemento da matriz será avaliado quando a instrução SE for
  executada.

Exemplos

Em uma planilha de orçamento, a célula A10 contém uma fórmula
para calcular o orçamento atual. Se o resultado da fórmula contida na célula A10
for menor que ou igual a 100, a função seguinte exibirá "Dentro do orçamento".
Caso contrário, a função exibirá "Acima do orçamento".

SE(A10&lt;=100,"Dentro do orçamento","Acima do
orçamento")

No exemplo a seguir, se o valor na célula A10 for 100, então
teste_lógico será VERDADEIRO e o valor total para o intervalo B5:B15 será
calculado. Caso contrário, se teste_lógico for FALSO e texto vazio ("") for
retornado a célula que contém a função SE será esvaziada.

SE(A10=100;SOMA(B5:B15);"")

Suponha que uma planilha de despesa contenha os seguintes dados
em B2:B4 em relação às "Despesas reais" para janeiro, fevereiro e março: 1500,
500, 500. C2:C4 contém os seguintes dados para "Despesas previstas" para os
mesmos períodos: 900, 900, 925.

Você poderia escrever uma fórmula para verificar se está acima
do orçamento em um mês específico, gerando texto para uma mensagem com as
seguintes fórmulas:

SE(B2&gt;C2;"Acima do orçamento";"OK") é igual a "Acima do orçamento"

SE(B3&gt;C3;"Acima do orçamento";"OK") é igual a "OK"

Como desproteger suas planilhas de Excel

Abra o editor de vba (alt+F11), insira um modulo e cole
este código, feche o editor de VBA e clique em ferramentas - macro - macros e
desproteger, execute, espere o programa varrer sua senha e assim você poderá
utilizar a planilha novamente.

**Obs. Em tópicos futuros ensinaremos a salvar seus arquivos como
suplementos.**


Sub
desproteger()
'O que
você quer, aqui você pode

'Modulo para desproteger suas planilhas de excel.
Dim i As Integer, j As Integer, k As
Integer
Dim l As
Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer

Dim i4 As Integer, i5 As
Integer, i6 As Integer

On Error Resume Next
For
i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For
i1 = 65 To 66
For i2 =
65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For
n = 32 To 126

ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _

Chr(l) &
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) &
Chr(i6) & Chr(n)
If
ActiveSheet.ProtectContents = False Then
MsgBox "One usable password is " &
Chr(i) & Chr(j) & _

Chr(k) & Chr(l) & Chr(m) &
Chr(i1) & Chr(i2) & _

Chr(i3) & Chr(i4) & Chr(i5) &
Chr(i6) & Chr(n)

Exit Sub

End If
Next:
Next: Next: Next: Next: Next

Next: Next: Next: Next: Next: Next
End Sub

Dúvidas? Deixe comentário.