Criando funções em VBa

Função validar Cpf

**Só uma pequena observação, quando utilizar esta função insira também os pontos**

Como calcular o DV do CPF
Para entender o algoritmo de cálculo do CPF vamos utilizar um exemplo prático.
Considere o seguinte CPF (sem o DV): 333.444.555
Posição 1 2 3 4 5 6 7 8 9
Número 3 3 3 4 4 4 5 5 5
Começamos a multiplicar os dígitos do CPF, a partir da posição 9, ou seja, de trás para frente, por 2, 3, 4, 5 e assim por diante, conforme indicado na tabela a seguir:
Posição 1 2 3 4 5 6 7 8 9
Número 3 3 3 4 4 4 5 5 5
Multiplica por: 10 9 8 7 6 5 4 3 2
Resultado 30 27 24 28 24 20 20 15 10
Somo os resultados obtidos na quarta linha da tabela anterior:
Soma1 = 30+27+24+28+24+20+20+15+10
Soma1 = 198
Faço a divisão desta soma por 11 e determino o resto da divisão:
198/11 Resulta em uma divisão exata, com resto 0
Regra : Quando o resto é zero ou um , o DV é 0.
Quando o resto é diferente de zero ou um , o DV é obtido fazendo-se: 11-resto
Neste caso como o resto foi zero, o primeiro DV é zero:
DV1=0
O DV1 calculado passa a fazer parte do CPF, conforme indicado pela tabela a seguir:
Posição 1 2 3 4 5 6 7 8 9 10
Número 3 3 3 4 4 4 5 5 5 0
Agora repetimos o processo anterior, porém já considerando o DV1 como parte integrante do CPF, conforme indicado pela tabela a seguir:
Posição 1 2 3 4 5 6 7 8 9 10
Número 3 3 3 4 4 4 5 5 5 0
Multiplica por: 11 10 9 8 7 6 5 4 3 2
Resultado 33 30 27 32 28 24 25 20 15 0
Somo os resultados obtidos na quarta linha da tabela anterior:
Soma2 = 33+30+27+32+28+24+25+20+15+0
Soma1 = 234
Faço a divisão desta soma por 11 e determino o resto da divisão:
234/11 Resulta em (21), com resto 3
Regra : Quando o resto é zero ou um , o DV é 0.
Quando o resto é diferente de zero ou um , o DV é obtido fazendo-se: 11-resto
Neste caso como o resto foi 3, o segundo DV é :
DV2 = 11 - 3
DV2 = 8
Com isso o CPF, já com os dois DVs fica conforme indicado na tabela a seguir:
Posição 1 2 3 4 5 6 7 8 9 10 11
Número 3 3 3 4 4 4 5 5 5 0 8
Ou seja: 333.444.555 - 08
Os algoritmos para cálculo dos DVs do CNPJ são praticamente iguais. A única diferença é a quantidade de dígitos do CNPJ é diferente do CPF.


Comentário

Agora que entendemos como funciona o calculo para o DV do CPF, vamos a função que poderá ser facilmente incluída em seus projetos de Excel.


Abra o Excel - insira um módulo e copie e cole o código abaixo, você também pode salvar como suplemento do Excel e utiliza-lo sempre.

Public Function ValidaCPF(CPF As String) As String

'Função para cálculo do dígito verificador do CPF

'Iniciamos a função com a declaração das variáveis que serão utilizadas.

' As variáveis d1 até d11, conterão os dígitos individuais
' do CPF. Por exemplo, ao digitar o CPF: 123.456.789-11, essas
' variáveis conterão os seguintes valores:
' d1=1 d2=2 d3=3 d4=4 d5=5 d6=5 d7=7 d8=8 d9=9 d10=1 d11=1

Dim d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11 As Integer

' Demais variáveis que serão utilizadas para o cálculo do DV.

Dim Soma1, Soma2, Resto As Integer
Dim Resto1, Resto2 As Integer
Dim DV1, DV2 As Integer

' Em primeiro lugar testo se a célula com o CPF contém um valor
' válido, isto é, um valor Não Nulo.

If Not (IsNull(CPF)) Then

'*************************************************************************
' Os comandos a seguir desmembram o CPF um a um , atribuindo os valores *
' de d1 ... d11 , usando as funções Mid$ e Val *
' Como o CPF está no formato de Texto, vamos extrair os dígitos do CPF *
' um a um, converter o respectivo valor de texto para número e atribuir *
' esse valor para as variáveis d1 até d11. *
'*************************************************************************

d1 = Val(Mid$(CPF, 1, 1))
d2 = Val(Mid$(CPF, 2, 1))
d3 = Val(Mid$(CPF, 3, 1))
d4 = Val(Mid$(CPF, 5, 1))
d5 = Val(Mid$(CPF, 6, 1))
d6 = Val(Mid$(CPF, 7, 1))
d7 = Val(Mid$(CPF, 9, 1))
d8 = Val(Mid$(CPF, 10, 1))
d9 = Val(Mid$(CPF, 11, 1))
d10 = Val(Mid$(CPF, 13, 1))
d11 = Val(Mid$(CPF, 14, 1))

'*************************************************************************
' A partir de agora passo a utilizar os valores anteriores para cálculo *
' do dígito verificador do CPF *
'*************************************************************************

' Cálculo do primeiro DV

Soma1 = ((d1 * 10) + (d2 * 9) + (d3 * 8) + (d4 * 7) + (d5 * 6) + (d6 * 5) + (d7 * 4) + (d8 * 3) + (d9 * 2))
Resto1 = (Soma1 Mod 11)

If (Resto1 <= 1) Then DV1 = 0 Else DV1 = 11 - Resto1 End If ' Agora inicio o cálculo do segundo DV, já incorporando ' o segundo DV como parte do CPF, para o cálculo. Soma2 = (d1 * 11) + (d2 * 10) + (d3 * 9) + (d4 * 8) + (d5 * 7) + (d6 * 6) + (d7 * 5) + (d8 * 4) + (d9 * 3) + (DV1 * 2) Resto2 = (Soma2 Mod 11) If (Resto2 <= 1) Then DV2 = 0 Else DV2 = 11 - Resto2 End If ' Agora faço o teste para saber se os DVs calculados (DV1 e DV2) ' conferem com os DVs do CPF - d10 e d11 If ((DV1 <> d10) Or (DV2 <> d11)) Then

' Atribuo a palavra "Inválido" para uma variável com o mesmo
' nome da função - ValidaCPF.
' Essa é a maneira de fazer com que a função retorne um valor,
' ou seja, atribuindo o valor a ser retornado, à uma variável
' com o mesmo nome da função.
ValidaCPF = "Inválido"

Else

' Atribuo a palavra "Válido" para uma variável com o mesmo
' nome da função - ValidaCPF.
' Essa é a maneira de fazer com que a função retorne um valor,
' ou seja, atribuindo o valor a ser retornado, à uma variável
' com o mesmo nome da função.
ValidaCPF = "Válido"

End If

End If

End Function

Função "E"

Função "E"

E(lógico1;lógico2; ...)

Lógico1; lógico2;... são de 1 a 30 condições que você deseja testar e que podem ser VERDADEIRO ou FALSO.
Os argumentos devem ser valores lógicos, matrizes ou referências que contêm valores lógicos.
Se uma matriz ou argumento de referência contiver texto ou células vazias, estes valores serão ignorados.
Se o intervalo especificado não contiver valores lógicos, E retornará o valor de erro #VALOR!.

Exemplos

E(VERDADEIRO; VERDADEIRO) é igual a VERDADEIRO
E(VERDADEIRO; FALSO) é igual a FALSO
E(2+2=4; 2+3=5) é igual a VERDADEIRO
Se B1:B3 contiver os valores VERDADEIRO, FALSO e VERDADEIRO, então:
E(B1:B3) será igual a FALSO
Se B4 contiver um número entre 1 e 100, então:
E(1 < B4; B4<100) será igual a VERDADEIRO
Suponha que você deseja exibir B4 se esta contiver um número entre 1 e 100, e que você deseja exibir uma mensagem se ela não contiver. Se B4 contiver 104, então:
SE(E(1 < B4 ; B4<100); B4; "O valor está fora do intervalo.") será igual a "O valor está fora do intervalo".
Se B4 contiver 50, então:
SE(E(1 < B4; B4<100); B4; "O valor está fora do intervalo.") será igual a 50

Procv

PROCV

Localiza um valor na primeira coluna à esquerda de uma tabela e retorna um valor na mesma linha de uma coluna especificada na tabela. Use PROCV em vez de PROCH quando os valores da comparação estiverem posicionados em uma coluna à esquerda ou à direita dos dados que você deseja procurar.

Sintaxe

PROCV(valor_procurado;matriz_tabela;núm_índice_coluna;procurar_intervalo)
Valor_procurado é o valor a ser procurado na primeira coluna da matriz. Valor_procurado pode ser um valor, uma referência ou uma seqüência de caracteres de texto.
Matriz_tabela é a tabela de informações em que os dados são procurados. Use uma referência para um intervalo ou nome de intervalo, tal como Banco de dados ou Lista.
Se procurar_intervalo for VERDADEIRO, os valores na primeira coluna de matriz_tabela deverão ser colocados em ordem ascendente: ..., -2, -1, 0, 1, 2, ... , A-Z, FALSO, VERDADEIRO; caso contrário, PROCV pode não retornar o valor correto. Se procurar_intervalo for FALSO, matriz_tabela não precisará ser ordenada.
Você pode colocar os valores em ordem ascendente escolhendo o comando Classificar no menu Dados e selecionando Crescente.
Os valores na primeira coluna de matriz_tabela podem ser texto, números ou valores lógicos.
Textos em maiúsculas e minúsculas são equivalentes.
Núm_índice_coluna é o número da coluna em matriz_tabela a partir do qual o valor correspondente deve ser retornado. Um núm_índice_coluna de 1 retornará o valor na primeira coluna em matriz_tabela; um núm_índice_coluna de 2 retornará o valor na segunda coluna em matriz_tabela, e assim por diante. Se núm_índice_coluna for menor do que 1, PROCV retornará o valor de erro #VALOR!; se núm_índice_coluna for maior do que o número de colunas em matriz_tabela, PROCV retornará o valor de erro #REF!.
Procurar_intervalo é um valor lógico que especifica se você quer que PROCV encontre a correspondência exata ou uma correspondência aproximada. Se VERDADEIRO ou omitida, uma correspondência aproximada é retornada; em outras palavras, se uma correspondência exata não for encontrada, o valor maior mais próximo que é menor que o valor_procurado é retornado. Se FALSO, PROCV encontrará uma correspondência exata. Se nenhuma correspondência for encontrada, o valor de erro #N/D é retornado.

Comentários

Se PROCV não localizar valor_procurado e procurar_intervalo for VERDADEIRO, ela usará o maior valor que for menor do que ou igual a valor_procurado.
Se valor_procurado for menor do que o menor valor na primeira coluna de matriz_tabela, PROCV fornecerá o valor de erro #N/D.
Se PROCV não localizar valor_procurado e procurar_intervalo for FALSO, PROCV fornecerá o valor #N/D.

Jogos em Excel

A partir do mês de Março/2008 começamos a disponibilizar jogos feitos em Excel para nossos usuários, se você gosta de Excel, e quer aprender um pouco mais sobre esse maravilhoso programa não deixe de visitar nosso site regularmente.

Clique aqui para baixar um incrível jogo de bolas.

Fórmula 1 (tabela)

Neste site você encontra praticamente tudo sobre a Fórmula 1.

**Calendário Fórmula 1 2008.
**Informações sobre os pilotos.
**Informações sobre as equipes.
**Autódromos.
**Classificação de pilotos.
**Classificação de equipes.
**História
**Campeões

Uma tabela super recheada de informações. Clique aqui para baixar.

Jogo da Memória (times de futebol)

Disponibilizamos aqui um maravilhoso jogo feito em Excel, neste jogo
inserimos escudos de 40 times de futebol , tais como, Corinthians, São Paulo, Santos, Palmeiras, Flamengo, Vasco, Fluminense, Botafogo, Real Madrid, Barcelona, etc...Clique aqui para baixar.

"Virus" em Excel

Muitas pessoas se perguntam como fazer um "virus" em excel, aqui mostramos não um vírus mas sim uma brincadeira que podemos fazer com amigos, baixe o arquivo e veja que interessante pode se transformar um pequeno e simples código de VBA. Clique aqui para baixar.

É importante ter uma impressora instalada.

Macros para novatos

Abaixo tentamos descrever as macros mais usadas. Lembrando que para utilizar estes códigos devemos abrir o Excel, entrar no editor do VBA (Alt + F11) e inserir um módulo.

Sub Ocultando_coluna()

' Macro gravada por Dicas de Excel

Columns("B:B").Select

Selection.EntireColumn.Hidden = True

End Sub

Sub Ocultar_Coluna()

' Forma abreviada

' Macro gravada por Dicas de Excel

Columns("C:C").EntireColumn.Hidden = True ' para reexibir altere true por false

End Sub

Sub Exibindo_coluna()

' Macro gravada por Dicas de Excel

Columns("B:B").Select

Selection.EntireColumn.Hidden = False

End Sub

Sub Exibindo_coluna2()

' Forma abreviada

' Macro gravada por Dicas de Excel

Columns("C:C").EntireColumn.Hidden = False

End Sub

Sub Selecionando_Planilha()

' Macro gravada por Dicas de Excel

Sheets("Plan2").Select

End Sub

Sub Selecinar_Célula()

' Macro gravada por Dicas de Excel

Range("B10").Select

End Sub

Sub Preencher_Célula()

' Macro gravada por Dicas de Excel

Range("B8").Select

ActiveCell.FormulaR1C1 = 10 ' vale lembrar que quando for referenciar números não é necessário o uso das aspas

End Sub

Sub Ocultar_Linha()

' Macro gravada por Dicas de Excel

Rows("8:8").EntireRow.Hidden = True ' para reexibir altere true por false

End Sub

Sub RenomearPlanilha()

' Macro gravada por Dicas de Excel

Sheets("Plan1").Name = "Teste"

End Sub

Sub Copiar_e_colar()

' Macro gravada por Dicas de Excel

Range("B5").Select

Selection.Copy

Range("B7").Select

ActiveSheet.Paste

End Sub

Sub imprimir()

' Macro gravada por Dicas de Excel

Sheets("Plan2").Select

ActiveWindow.SelectedSheets.PrintOut

End Sub

Sub MaximizarTela()

' Macro gravada por Dicas de Excel

ActiveWindow.WindowState = xlMaximized 'para minimizar altere para xlMinimized

End Sub

Sub Macro_otimizada()

' Macro gravada por Dicas de Excel

' Nesta macro iremos criar um novo documento, inserir dados em células, renomear planilhas e criar uma formula simples.

‘Se houver alguma duvida sobre a macro criada refaça passo a passo até o total entendimento.

Workbooks.Add

ActiveWorkbook.SaveAs "C:\Meus documentos\Dados.xls"

ActiveWorkbook.Worksheets.Add

ActiveSheet.Name = "Dados"

Workbooks.Add

ActiveWorkbook.SaveAs "C:\Meus documentos\Resultados.xls"

ActiveWorkbook.Worksheets.Add

ActiveSheet.Name = "Resultados"

Workbooks("Dados.xls").Sheets("Dados").Range("A1").Value = 10

Workbooks("Dados.xls").Sheets("Dados").Range("A2").Value = 20

Workbooks("Dados.xls").Sheets("Dados").Range("A3").Value = 30

Workbooks("Dados.xls").Sheets("Dados").Range("B1").Value = 100

Workbooks("Dados.xls").Sheets("Dados").Range("B2").Value = 200

Workbooks("Dados.xls").Sheets("Dados").Range("B3").Value = 300

Workbooks("Dados.xls").Sheets("Dados").Range("C1").Value = 1000

Workbooks("Dados.xls").Sheets("Dados").Range("C2").Value = 2000

Workbooks("Dados.xls").Sheets("Dados").Range("C3").Value = 3000

Workbooks("Resultados.xls").Sheets("Resultados").Range("A1").Value = "Total da Coluna A"

Workbooks("Resultados.xls").Sheets("Resultados").Range("B1").Value = "Total da Coluna B"

Workbooks("Resultados.xls").Sheets("Resultados").Range("C1").Value = "Total da Coluna C"

Workbooks("Resultados.xls").Sheets("Resultados").Range("A2").Value = "=SUM([Dados.xls]Dados!$A$1:$A$3)"

Workbooks("Resultados.xls").Sheets("Resultados").Range("B2").Value = "=SUM([Dados.xls]Dados!$B$1:$B$3)"

Workbooks("Resultados.xls").Sheets("Resultados").Range("C2").Value = "=SUM([Dados.xls]Dados!$C$1:$C$3)"

End Sub

Fechando outros arquivos de Excel

Existem planilhas pesadas que sobrecarregam nossas máquinas e deixam nosso ambiente de trabalho lento. Para que isso não ocorra com o Excel aí vai uma super dica: quando abrirmos uma nova planilha o Excel fecha e salva o arquivo anterior, não permitindo que o sistema fique sobrecarregado.

Em EstaPasta_de_Trabalho insira o código abaixo.

Private Sub Workbook_Open()

outrasjanelas

End Sub

Simples não? Mas para que nosso código funcione, insira um módulo e copie o seguinte código:

Sub outrasjanelas()

Application.EnableCancelKey = xlDisabled

On Error Resume Next

n = Application.Windows.Count

If (n > 1) Then

resp = MsgBox("É preciso fechar os outros arquivos de Excel para abrir este." & Chr(13) & "Deseja fechar os outros arquivos agora ?", vbYesNo + vbExclamation, "Fechar arquivos")

If (resp = vbYes) Then

For i = 1 To n

If (Application.Windows(i).Caption <> ThisWorkbook.Name) Then

Application.Windows(i).Close SaveChanges:=True

End If

Next i

For i = 1 To n

If (Application.Windows(i).Caption <> ThisWorkbook.Name) Then

Application.Windows(i).Close SaveChanges = True

End If

Next i

Else

MsgBox "Esta tabela será fechada." & Chr(13) & "Feche os outros arquivos e abra a tabela novamente.", vbOKOnly + vbExclamation, "Fechando tabela"

ThisWorkbook.Close

End If

End If

End Sub

Bloqueando teclas no Excel

Neste novo tópico estamos disponibilizando mais uma super dica de EXCEL / VBA, mais um exemplo prático de como bloquear os seus documentos de Excel através desta maravilhosa linguagem que é o VBA.

Em Estapasta_de_trabalho insira o seguinte código:


Private Sub Workbook_BeforeClose(Cancel As Boolean)

proibirtec

End Sub

Private Sub Workbook_Open()

Senha = "123"

If Application.inputbox("digite sua senha") = Senha Then

permitirtec

Else

proibirtec

End If

End Sub



Feito isso, crie um módulo e adicione o seguinte código:

Function mensagem()

MsgBox "Teclas bloqueadas.", vbOKOnly + vbExclamation, "Falta Permissão"

Application.EnableCancelKey = xlDisabled

End Function

Sub proibirtec()

Application.OnKey "^{BREAK}", "mensagem"

Application.OnKey "^o", "mensagem"

Application.OnKey "^a", "mensagem"

Application.OnKey "^c", "mensagem"

Application.OnKey "^v", "mensagem"

Application.OnKey "^x", "mensagem"

Application.OnKey "^r", "mensagem"

Application.OnKey "^y", "mensagem"

Application.OnKey "^k", "mensagem"

Application.OnKey "^1", "mensagem"

Application.OnKey "{F1}", "mensagem"

Application.OnKey "{F7}", "mensagem"

Application.OnKey "^{F1}", "mensagem"

Application.OnKey "{F11}", "mensagem"

Application.OnKey "%{F11}", "mensagem"

Application.OnKey "%{F8}", "mensagem"

Application.OnKey "%l", "mensagem"

Application.OnKey "%u", "mensagem"

End Sub

Sub permitirtec()

Application.OnKey "^{BREAK}"

Application.OnKey "^o"

Application.OnKey "^a"

Application.OnKey "^c"

Application.OnKey "^v"

Application.OnKey "^x"

Application.OnKey "^r"

Application.OnKey "^y"

Application.OnKey "^k"

Application.OnKey "^1"

Application.OnKey "{F1}"

Application.OnKey "{F7}"

Application.OnKey "^{F1}"

Application.OnKey "{F11}"

Application.OnKey "%{F11}"

Application.OnKey "%{F8}"

Application.OnKey "%l"

Application.OnKey "%u"

End Sub