Código VBA, Prontos.

Sub Desbloqueia_Planilha()

'Desbloqueia qualquer planilha 

Dim i As Integer, j As Integer, k As Integer

Dim l As Integer, m As Integer, n 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 "Sua planilha foi desbloqueada "

Exit Sub

End If

Next

Next

Next

Next

Next

Next

Next

Next

Next

Next

Next

Next

End Sub

Sub Barra_de_Status()

application.statusbar = "Esta Planilha foi desenvolvida por..."

'Com esse código vc informa um texto na barra de status da planilha.
end Sub

Sub Nova_Aba()

sheets.add

sheets("plan2").name = "TESTE"
'Com esse código vc cria uma nova aba com o nome que quizer
End Sub

Sub Salvar_Planilhas()

ActiveWorkbook.save

'Com este código podemos salvar as ações da macro
End Sub

Plan1.Select
[M18].Value = Application.WorksheetFunction.VLookup([M17].Value, [A2:L13], 3, 0)

'Na planilha1 (Propiedades), a celula M18 recebe o valor do resultado sendo

procurado o valor ba célula M17, no intervalo [A2:L13] da terceira coluna com valor exato
End Sub

Application.DisplayFormulaBar = True ' Habilita ou Desabilita barra de formulas
Application.DisplayScrollBars = True 'Habilita ou Desabilita barra de rolagem Verticais e horizontais
Application.DisplayStatusBar = True 'Habilita ou Desabilita barra de Status
Application.DisplayFullScreen = True 'Habilita ou Desabilita tela cheia
ActiveWindow.DisplayVerticalScrollBar = True 'Habilita ou Desabilita barra de rolagem vertical

ActiveWindow.DisplayHorizontalScrollBar = 'True 'Habilita ou Desabilita barra de rolagem horizontal
ActiveWindow.DisplayHeadings = True 'Habilita ou Desabilita INFO linhas e colunas
ActiveWindow.DisplayRuler = True 'Habilita ou Desabilita régua
ActiveWindow.DisplayWorkbookTabs = True 'Habilita ou Desabilita listagem de abas
End Sub

ActiveSheet.Shapes("Nome").Visible = True

'Macro para Visualizar ou ocultar shapes, ex: Marca dágua

End Sub

ActiveSheet.PageSetup.PrintArea = Range("A1:C10").Address

'Com esse código é possivel estabelecer uma área de impressão
End Sub

Sub Adicionar_Planilha ()
sheets.add
Activesheet.name=inputbox("Digite o Nome da Planilha",Cadastro)

'Com esse código vc cria uma nova planilha como o nome que quizer
End sub

Sub Mensagens_Hora()

Dim MinhaHora
MinhaHora = Hour(Now)
Select Case MinhaHora
Case 1 To 5
MsgBox “Bom Noite” & Application.UserName
Case 6 To 11
MsgBox “Bom Dia ” & Application.UserName
Case 12 To 17
MsgBox “Bom Tarde ” & Application.UserName
Case 18 To 24
MsgBox “Bom Noite ” & Application.UserName
End Select
End Sub

Variant – Tipo Genérico

Boolean – True ou False (Veradeiro ou Falso)
Byte – Número inteiro de 0 a 255
Integer – Número inteiro de -32.768 a 32.767
Long – Número inteiro de -2.147.483.648 e 2.147.783.647
Double – Número entre -1,79769313486232E308 e -4.94065645841247E–324
ou 1,79769313486232E308 e 4.94065645841247E–324
Currency – Quantia monetária entre 922.337.203.685.477,5808 e
922.337.203.685.477,5807
Date – Data entre 1/Janeiro/0100 e 31/Dezembro/9999
String – Texto com até 2 bolhões de caracteres.

UltimaLinha = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'Código que detecta a Ultima Linha preenchida

End Sub

Sub Ultima_Linha_Vazia()

Linha = 1 ‘Variável recebe o valor de 1

Cel = Cells(Linha, 1).Value  ‘Contagem inicia na célua A1

Do While Cel <> “” ‘Faça enquanto a variável "Cel" for diferente de  vazio

Linha = Linha + 1 ‘Soma ela mesma, pula para próxima linha

Cel = Cells(Linha, 1).Value  ’Verifica novo conteudo

Loop ‘Fecha o laço 

End Sub

Sub Ultima_Linha_Preenchida()

Ln = Application.WorksheetFunction.CountA(Plan1.Columns(1))

'Código que detecta a Ultima Linha preenchida

End Sub

Private Sub ListBox1_Click()

Label1.Caption = ListBox1.Listcount

'Label1 é um nome do rótulo

'Informar a quantidade de linhas da lista do ListBox1

End Sub

Plan1.Range("a:a").SpecialCells(xlCellTypeBlanks).Delete
'Deleta linhas em branco das células selecionadas

End Sub

Dim i As Integer 'variável

Dim n As Integer 'variável

Dim Soma As Integer 'variável

n = InputBox("Entre com o total de números:")

i = 1 'Início

Soma = 0 'Zerar

Do While i <= n 'Condição

Soma = Soma + Cells(i, 1)  'Valores à celula desejada

i = i + 1 'Adicionar valor p/ fechar o laço

Loop 'Laço

Cells(n + 1, 1) = Soma 'Celula recebendo o valor da Soma

End Sub

Sub Somar_For()

Dim i As Integer 'variável

Dim soma As Double 'variável

Dim n As Integer 'variável

n = InputBox("n=")

soma = 0 ' Zerar

For i = 1 To n 'Condição

soma = soma + (i) ^ (i - 1) 'Formula

Next i 'Laço

MsgBox (" A soma é: " & soma) 'Mensagem

'Resultado da soma na mensagem

End Sub

Private Sub Workbook_Open() 
    Dim Var1 As Integer ' Variável 1
    Dim Var2 As String ' variável 2
    'Recebendo Valores
    Var1 = Sheets("Plan1").Range("A2").Value
    Var2 = Format(Var1 + 1, "0000")
    'Atualizando os Valores
    Sheets("Plan1").Range("A2").Value = Var2
    ActiveWorkbook.Save
End Sub

Sub Selecionar_Celulas ()

Plan1.Range("A1:D5").selected

'Código para selecionar campo da planilha 

End Sub

Sub Visualizar_Planilhas()

Application.visible= True

'Código utilizado para vizualizar ou não a planilha,muito usado

no momento que desejamos apenas visualizar o formulário.

End Sub

Ultimacoluna = Cells(1, Cells.Columns.Count).End(xlToLeft).Column

'Código usado para identificar a ultima coluna preenchida

End Sub

Sub Proteger()

Worksheets("Plan1").Protect ("Senha")

End Sub

Sub Habilitar_Marca_dagua()

ActiveSheet.Shapes("marcadagua").Visible = True
End Sub
'Insira No WordArt o texto e depois defina o nome "marcadagua"

Private Sub UserForm_Initialize()
Linha = Activecell.Cells(Rows.Count,1).end(xlUP).Row

Combobox1.Rowsource = "A2:A"&Linha

End Sub

Carregar_ListBox

Private Sub UserForm_Initialize()
ListBox1.RowSource = "a2:b" & Plan1.Range("a2").End(xlDown).Row

'Carregar uma lista no ListBox

'Na propriedade "ColumnCount" informe a quantidade de colunas desejada
End Sub

Sub Mensagem()

MSG = MsgBox("Responda sim ou não", vbInformation + vbYesNo, "TESTE")
If MSG = vbYes Then 'Condição
MsgBox "Resposta sim"
Else
MsgBox "Resposta não"
End If
End Sub

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
'Com essa macro é possovel seelcionar todo material da plnailha ativa
End Sub

Application.OnTime Now + TimeValue("00:00:02"), "Atual" 

'Temo de 2 segundo do sistema chamando a macro "Atual" 

End  Sub

Sub Atual()

Application.CalculateFullRebuild 'Aplicação que atualiza toda Planilha

End Sub

'Chamar "Atualizar" com Workbook_SheetSelectionChange

Function ContaCelulaColorida(Cor As Range, Intervalo As Range) As Long

Dim Conta As Range 'Declarar Variáveis

For Each Conta In Intervalo.Cells 'Inicio do Laço com For Each

If Conta.Interior.ColorIndex = Cor.Interior.ColorIndex Then 'Condição

ContaCelulaColorida = ContaCelulaColorida + 1 'Acrescentar valor fórmula

End If 'Fim da condição

Next 'Fechando o Laço

End Function

Function ContaCelulaColorida(Cor As Range, Intervalo As Range) As Long

Dim Conta As Range 'Declarar Variáveis

For Each Conta In Intervalo.Cells 'Inicio do Laço com For Each

If Conta.Interior.ColorIndex = Cor.Interior.ColorIndex Then 'Condição

ContaCelulaColorida = ContaCelulaColorida + 1 'Acrescentar valor fórmula

End If 'Fim da condição

Next 'Fechando o Laço

End Function

Public Function ExtrairNumeros(Var As Range) As String
Dim i As Long ' Declarar variáveis
    ExtrairNumeros = Var.Text 'Função recebe o texto da variável
    For i = 0 To 9 'inicio do laço for to
        ExtrairNumeros = Replace(ExtrairNumeros, i, "", 1) ' 
    Next i
 
End Function

Public Function ExtrairNumeros(Var As Range) As String
Dim i As Long ' Declarar variáveis
    ExtrairNumeros = Var.Text 'Função recebe o texto da variável
    For i = 0 To 9 'inicio do laço for to
        ExtrairNumeros = Replace(ExtrairNumeros, i, "", 1) ' 
    Next i
 
End Function

Function Somar2(Area As Range) As Interger _
Optional Multiplicador as Integer

Dim Saida  As Integer ' Declarar variáveis
    For Each Celula in Area.Cells 'Laço de Repetição For Each Selecionar 

    Saida=Saida+Celula.Value 'Variável recebendo valores

Next
IF Multiplicador>0 Then 'Condição de veracidade 

    Saida=Saida* Multiplicador 'Multiplicar o Valor da variável
End IF

Somar2=Saida 'A função Somar2 recebe a variável que carregou os valores
End Function

Sub Endereco_Arquivo()

'Macro que coloca no rodape o caminho do arquivo
ActiveSheet.PageSetup.RightFooter="&Z&F"
End Sub

Carregar_ListBox

Private Sub UserForm_Initialize()
ListBox1.RowSource = "a2:b" & Plan1.Range("a2").End(xlDown).Row

'Carregar uma lista no ListBox

'Na propriedade "ColumnCount" informe a quantidade de colunas desejada
End Sub

Carregar_Combobox

Private Sub UserForm_Initialize()
Linha = Activecell.Cells(Rows.Count,1).end(xlUP).Row

Combobox1.Rowsource = "A2:A"&Linha

End Sub

Carregar_Imagem

Private Sub CommandButton1_Click()

'A imagem recebeu o name de "Foto"

'Declare um variável em um módulo como global chamado de FotoPlanilha

'Ação do botão será

FotoPlanilha = application.getopenfilename(Filterfile:="Picture File,*.bmp")

Foto.Picture = Loadpicture (FotoPlanilha)

End Sub

Configurar_TexBox_Data

Private Sub TxtAdmissao_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

'Selecione a propriedade MaxLenght e dê o valor de 10

'Agora no precedimento Keypress faça o seguinte

If Len(TxtBox1) = 2 Then
TxtBox1.Text = TxtBox1.Text + "/"
End If
If Len(TxtBox1) = 5 Then
TxtBox1.Text = TxtBox1.Text + "/"
End If

End Sub

'Uso na inicialização com uma imagem na mesma pastas do arquivo

Private Sub UserForm_Initialize()

Set Grafico = Plan1.ChartObjects(1).Chart

    Grafico.Parent.Width = 200

    Grafico.Parent.Height = 200

'   Save chart as GIF

    Fname = ThisWorkbook.Path & Application.PathSeparator & "temp.gif"

    Grafico.Export Filename:=Fname, FilterName:="GIF"

'   Show the chart

    Image1.Picture = LoadPicture(Fname)

End Sub

Excluirr_Registro

Private Sub CommandButton2_Click()

Sheets("Plan1").Select

Range("a1").Select

'Laço de repetiçãoço

For cont = 1 To 20

If ActiveCell = TextBox1.Text Then

resposta = MsgBox("Deseja Excluir Resporta?", 3, "ECLUIR")

End If

'Ação depois da mensagem

If resposta = vbYes Then

ActiveCell.EntireRow.Delete

End If

'Deslocar uma linha depois da exclusão

ActiveCell.Offset(1, 0).Activate

Next

Range("a1").Select

'Ativar a célula A1

End Sub

FotoPlanilha = application.getopenfilename(Filterfile:="Picture File,*.bmp")

Foto.Picture = Loadpicture (" ")

End Sub

Application.visible = False

'Limpar_Imagem

Foto.Picture = Loadpicture (" ")

'Posicionar_Cursor_Inicial

Textbox1.Text = Setfocus

WORKFUNCTION - Fórmulas do applications

Variável = Application.Workfunction.xxxxxxxx

1. Categoria: Matemática e Trigonométrica

• ABS=ABS

• ARRED=ROUND

• MARRED=MROUND

• MULT=PRODUCT

• SINAL=SING

• SOMA = SUM

• SOMARPRODUTO=SUMPRODUCT

• SOMASE=SUMIF

• SOMASES=SUMIFS

• SUBTOTAL=SUBTOTAL

• TETO=CEILING

• TRUCAR=TRUC

 2. Categoria: Data e Hora

• Como manipular datas e horas corretamente no Excel

• Como calcular diferenças de datas e horas no Excel

• AGORA=NOW

• ANO=YEAR

• DATA=DATE

• DATADIF=DATEDIF

• DATAM=EDATE

• DIA=DAY

• DIATRABALHO=WORKDAY

• DIATRABALHO.INTL

• DIATRABALHOTOTAL

• DIATRABALHOTOTAL.INTL

• FIMMÊS=EOMONTH

• HOJE=TODAY

• MÊS=MONTH

• NÚMSEMANA=WEEKNUM

3. Categoria: Texto

• ARRUMAR=TRIM

• CONCATENAR=CONCATENATE

• DIREITA=RIGHT

• ESQUERDA=LEFT

• EXT.TEXTO=MID

• LOCALIZAR=SEARCH

• MAIÚSCULA=UPPER

• MINÚSCULA=LOWER

• MUDAR=REPLACE

• NÚM.CARACT=LEN

• PRI.MAIÚSCULA=PROPER

• TEXTO=TEXT

• TIRAR=CLEAN

4. Categoria: Estatística

• CONT.NÚM=COUNT

• CONT.SE=COUNTIF

• CONT.SES=COUNTIFS

• CONT.VALORES=CONTA

• CONTAR.VAZIO=COUNTBLANK

• MÁXIMO=MAX

• MÉDIA = AVERAGE

• MÍNIMO=MIN

• MAIOR=LARGE

• MENOR=SMALL

• ORDEM=ORDEM

5. Categoria: Pesquisa e Referência

• COL=COLUMN

• CORRESP=MATCH

• DESLOC=

• ESCOLHER=CHOOSE

• ÍNDICE=INDEX

• INDIRETO=INDIRECT

• LIN=ROW

• PROC=LOOKUP

• PROCH=HLOOKUP

• PROCV=VLOOP

• TRANSPOR

6. Categoria: Lógicas

• E

• OU

• SE

• SEERRO

7. Categoria: Informações

• ÉCÉL.VAZIA

• É.NÃO.DISP

• ÉERROS

• ÉNÚM

• ÉTEXTO

8. Categoria: Financeira

Importante: apresentaremos as funções com exemplos, porém não abordaremos conceitos de matemática financeira.

• NPER

• PGTO

• TAXA

• VF

• VFPLANO

• VP

9. Categoria: Banco de Dados

• BDCONTAR

• BDEXTRAIR

• BDMÁX

• BDMÉDIA

• BDMÍN

• BDSOMA