Vba - Excel

Link download VBA EXCEL 365

https://products.office.com/pt-br/business/get-latest-office-365-for-your-business-with-2016?omkt=pt-BR&WT.mc_id=PS_Google_O365SMB_download%20excel&WT.srch=1omkt=pt-BR&WT.mc_id=PS_Google_O365SMB_download%20excel&WT.srch=1&gclid=CjwKEAjwsMu5BRD7t57R1P2HwBgSJABrtj-R7C8JRNMK0SAAdMnoTr0hrc_jlLx7yZe8KDR5jdIT-RoCaLXw_wcB

Criar Um Vetor para 3 Produtos e uma Matriz Com Valores de Venda em 3 Semestre Somar as Vendas por Produto e o Total Geral

Sub loja()
Dim matriz(3, 2) As Currency
Dim vetor(3) As String
Dim total(3) As Currency

Dim i As Integer
Dim l As Integer
Dim m As Integer
Dim m2 As Integer
Dim msg As String

For i = 0 To 3
vetor(i) = InputBox("Digite o nome do produto " & i + 1)
For l = 0 To 2
matriz(i, l) = InputBox("Digite o valor " & l + 1)
total(i) = total(i) + matriz(i, l)
Next
Next

For m = 0 To 3
MsgBox ("Produto: ") & vetor(m) & Chr(13) + ("Preço mes Janeiro: ") & matriz(m, 0) & Chr(13) + ("Preço mes Fevereiro: ") & matriz(m, 1) & Chr(13) + ("Preço mes Março: ") & matriz(m, 2) & Chr(13) + ("TOTAL : ") & total(m)

Next
MsgBox ("Total de Tudo: ") & total(0) + total(1) + total(2) + total(3)
MsgBox ("William Rodrigo Da Silva") & Chr(13) + ("Ja era Galera o programa era esse ae, BOA FERIAS PRA GERAL")
End Sub

Codigo Formulário Cadastro de Produto

Private Sub btnCadastrar_Click()
'declarar variaveis
Dim linha As Integer
Dim ws As Worksheet
Dim codigoProduto As Integer
Dim descricao   As String
Dim quantidadeEstoque As Integer
Dim valorUnitario As Currency
Dim valorTotal As Currency
'Identificar qual Planilha ta a Tabela
Set ws = Worksheets(1)
'Posicionar celula abaixo da ultima prenchida
linha = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

'verificar o que o usuário digitou certo
If Not IsNumeric(txtCodigoProduto.Text) Then
    MsgBox "Codigo do Produto deve ser numerico"
    txtCodigoProduto.Text = ""
    txtCodigoProduto.SetFocus
    Exit Sub
End If

If txtDescricao.Text = "" Then
    MsgBox "Voce deve Digitar a Descrição do Produto"
    txtDescricao.SetFocus
    Exit Sub
End If

If Not IsNumeric(txtQuantidadeEstoque.Text) Then
    MsgBox "Valor Quantidade deve ser Numerico"
    txtQuantidadeEstoque.Text = ""
    txtQuantidadeEstoque.SetFocus
    Exit Sub
End If

If Not IsNumeric(txtValorUnitario.Text) Then
    MsgBox "Valor Unitário deve ser Numerico"
    txtValorUnitario.Text = ""
    txtValorUnitario.SetFocus
    Exit Sub
End If
   
    ' passar dados do formulário para planilha
    'alimentar as variaveis
   
    codigoProduto = txtCodigoProduto.Text
    descricao = UCase(txtDescricao.Text)
    quantidadeEstoque = txtQuantidadeEstoque.Text
    valorUnitario = txtValorUnitario.Text
   
    'jogar os dados das variáveis em cada celula
    ws.Cells(linha, 1).Value = codigoProduto
    ws.Cells(linha, 2).Value = descricao
    ws.Cells(linha, 3).Value = quantidadeEstoque
    ws.Cells(linha, 4).Value = valorUnitario
    valorTotal = valorUnitario * quantidadeEstoque
    ws.Cells(linha, 5).Value = valorTotal
   
    'Avisar Usuario que deu certo
    MsgBox "Cadastro Efetuado com Sucesso"
   
    'Limpa Formulário
    txtCodigoProduto.Text = ""
    txtDescricao.Text = ""
    txtValorUnitario.Text = ""
    txtQuantidadeEstoque.Text = ""
   
    'Colocar o foco no primeiro controle
    txtCodigoProduto.SetFocus
   
End Sub

Private Sub txtQuantidadeEstoque_Change()

End Sub

Funcao Date Retorna Semana Apartir da Data Atual

Sub teste3()
Dim data As Date
data = Date
MsgBox DateAdd("ww", 9, data)
'Retorna semana apartir da data Atual
End Sub

Funcao Date Data Ate 9 mese

Sub teste2()
Dim data As Date
data = Date
MsgBox DateAdd("q", 3, data)
'Retorna daqui 9 meses
End Sub

Funcao Date 2

Sub teste1()
'Acrescentar dias a uma data
Dim dataemissao As Date
Dim datavencimento As Date
Dim periodo As Integer
dataemissao = Date
periodo = CInt(InputBox("Quantos dias para o Vencimento"))
datavencimento = DateAdd("d", periodo, dataemissao)
MsgBox datavencimento
End Sub

Funcao Date

Sub teste()
Dim data As Date
data = CDate(InputBox("Digite a data que venceu a Duplicata : "))
'MsgBox Weekday(data)
'Diferença de dias entre uma data e outra
Dim dias As Integer
Dim meses As Integer
meses = DateDiff("m", data, Date)
dias = DateDiff("d", data, Date)
MsgBox dias
MsgBox meses
End Sub

Programinha Que Gera Uma Pilha Com Nome Digitado

Sub ExemploUltimoNome()
    Dim palavra As String
    palavra = UCase(InputBox("Digite uma palavra"))
    Dim i As Integer
    Dim mensagem As String
    For i = 1 To Len(palavra)
        mensagem = mensagem & Mid(palavra, 1, i) & Chr(13)
    Next
    MsgBox mensagem
End Sub

Programinha Que Seleciona Primeiro Nome e Ultimo Sobrenome

Sub comequeficosabendo()
    Dim palavra As String
    Dim letra As String
    palavra = UCase(InputBox("Digite uma palavra"))
    Dim pos_espaco As Integer
    pos_espaco = InStr(1, palavra, " ")
    Dim resultado As String
    resultado = Mid(palavra, 1, pos_espaco)
    MsgBox resultado
    resultado = Mid(palavra, InStrRev(palavra, " ") + 1, Len(palavra) - InStrRev(palavra, " "))
    MsgBox resultado
   
End Sub

Gerar um Jogo Para MegaSena Funções Internas

Sub Exemplo_Funcoes()
'gerar um numero randomico
'gerar um jogo para megaSena
Dim jogo(5) As Integer
Dim qtd As Integer
Dim gerado As Integer
Dim i As Integer
Dim tem As Boolean
Dim mensagem As String

qtd = 0
Do While (qtd < 6)
 gerado = Int(Rnd() * 60)
    For i = 0 To 5
    If gerado = jogo(i) Then tem = True
    Next
    If tem = False Then
    jogo(qtd) = gerado
    qtd = qtd + 1
    End If
Loop

For i = 0 To 5
mensagem = mensagem & jogo(i) & " "
Next

MsgBox mensagem

End Sub

Tabuada Vetor "Array"

Sub tabuadaVetorArray()
Dim A(10) As Integer
Dim i     As Integer
Dim n     As Integer
Dim m     As String

n = InputBox("Digite o Numero que Deseja a Tabuada: " & n + 1)
For i = 0 To 10
  A(i) = n * i
Next
For i = 0 To 10
m = m & n & " X " & i & " = " & A(i) & Chr(13)
Next

MsgBox m
End Sub

Exercicio Maromo Matriz Vetor

Sub MatrizVetor()
Dim v(6, 6) As Integer
Dim l     As Integer
Dim c     As Integer
Dim x     As String
Dim y     As String

For l = 0 To 6
  For c = 0 To 6
        v(l, c) = 1
   
      If l < c Then
        v(l, c) = 2
      End If
   
      If l > c Then
        v(l, c) = 0
      End If
   Next
 Next
 
 For l = 0 To 6
    For c = 0 To 6
    x = x & v(l, c)
    Next
 y = y + x
 x = ""
 y = y & Chr(13)
 Next

Debug.Print y

End Sub

Matriz Multidimencional

Sub MatrizMultidimencional()

'Representação de linha e coluna
'3x2 (3 linhas / 2 colunas)
'5x5 (5 linhas / 5 colunas)
'Dim matriz(2,1) as integer "Matriz de 3 linha 2 Coluna"
'Dim matriz(4,4) as integer "Matriz de 5 linhas 5 colunas"
' 5 nomes 2 Notas e a Media

 Dim nome(4) As String
 Dim resultado(4) As String
 Dim nota(4, 2) As Double
 Dim n As Integer
 Dim c As Integer
 Dim mensagem As String

'Alimentar os dados Vetor e Matriz
 For n = 0 To 4
 nome(n) = InputBox("Nome do Aluno" & n + 1)
 nota(n, 0) = CDbl(InputBox("Nota da Primeira Prova: " & nome(n)))
 nota(n, 1) = CDbl(InputBox("Nota da Segunda Prova: " & nome(n)))
 nota(n, 2) = (nota(n, 0) + nota(n, 1)) / 2

 If nota(n, 2) >= 6 Then
  resultado(n) = "Aprovado"
 Else
  resultado(n) = "Reprovado"
  End If
  Next
 
For n = 0 To 4
    mensagem = mensagem & "Nome : " & nome(n) & " Media : " & nota(n, 2) & " Situação : " & resultado(n) & Chr(13)
Next
    MsgBox mensagem
End Sub

Vetor de Ordenaçaõ Professor Maromo

Sub SubOrdenChoquito()
Dim v(4)  As Integer
Dim i     As Integer
Dim j     As Integer
Dim troca As Integer

For i = 0 To 4
v(i) = CInt(InputBox("Digite um Valor: "))
Next

For i = 0 To 4
    For j = 0 To 4
         If v(i) > v(j) Then
         troca = v(i)
         v(i) = v(j)
         v(j) = troca
         End If
    Next
Next

For i = 0 To 4
Debug.Print v(i)
Next
End Sub

Vetor Dinamico VBA Excel

Sub vetordinamico()
Dim v() As Integer
Dim q As Integer
Dim i As Integer
q = CInt(InputBox("Digite o Tamanho do vetor : "))
q = q - 1
ReDim v(q)
For i = 0 To q
    v(i) = CInt(InputBox("Digite um Valor: "))
Next

For i = 0 To q
Debug.Print v(i)
Next
   
End Sub

'Incrementa o Vetor com 10 Nomes , Imprime do Ultimo pro Primeiro Nome Digitado

Sub pratica1()
Dim nome(9) As String
Dim i As Integer


'Incrementa o Vetor com 10 Nomes
    For i = 0 To 9
    nome(i) = InputBox("Digiete o Nome : ")
    Next

'Imprime do Ultimo pro Primeiro Nome Digitado  
    For i = 9 To 0 Step -1
    MsgBox nome(i)
    Next


End Sub

Exemplo Vetor Imprimir e Contador

Sub ExemploVetor1()
Dim valor(6) As Integer
Dim i        As Integer
Dim conta   As Integer

'encrementar valor no vetor
For i = 0 To 6
valor(i) = CInt(InputBox(" Digite um valor"))
Next

'imprimir valores encrementados
For i = 0 To 6
    'selecionar impares
    If valor(i) Mod 2 = 1 Then

    'contar quantidades de Numeros Impares incrementados
    conta = conta + 1
        MsgBox valor(i)
    End If
Next
MsgBox "total de impares: " & conta
End Sub

Exemplo Vetor

Sub ExemploVetor()
Dim valor(6) As Integer
Dim i        As Integer

'encrementar valor no vetor
For i = 0 To 6
valor(i) = CInt(InputBox(" Digite um valor"))
Next

'imprimir valores encrementados
For i = 0 To 6
MsgBox valor(i)
Next

End Sub

Exemplo de código com While

Sub Do_Loop_While_no_início()
'Exemplo de código com While no início do trecho de código:
Dim x As Integer
Dim Contador As Integer
Dim Soma As Integer
x = 10
Contador = 1
Soma = 0
' Efetua a soma dos dez primeiros números maiores que zero.
Do While Contador < x
Soma = Soma + Contador
Contador = Contador + 1
Loop
MsgBox "soma = " & Soma & " Contador = " & Contador
End Sub

Sub Do_Loop_While_no_final()
'Exemplo de código com While no final do trecho de código:
Dim x, Contador, Soma
x = 10
Contador = 1
Soma = 0
'Efetua a soma dos dez primeiros números maiores que zero.
Do
Soma = Soma + Contador
Contador = Contador + 1
Loop While Contador < x
MsgBox "Soma = " & Soma & " " & " Contador = " & Contador
End Sub


Sub Do_Loop_Until_no_início()
'Exemplo de código com Until no início do trecho de código:
Dim x, Contador, Soma
x = 10
Contador = 1
Soma = 0
'Efetua a soma dos dez primeiros números maiores que zero.
Do Until Contador >= x
Soma = Soma + Contador
Contador = Contador + 1
Loop
MsgBox " soma = " & Soma & " " & " Contador = " & Contador
End Sub


Sub Do_Loop_Until_no_final()
'Exemplo de código com Until no final do trecho de código:
Dim x, Contador, Soma
x = 10
Contador = 1
Soma = 0
'Efetua a soma dos dez primeiros números maiores que zero.
Do
Soma = Soma + Contador
Contador = Contador + 1
Loop Until Contador >= x
MsgBox "Soma = " & Soma & "  " & "Contador = " & Contador
End Sub


Sub While_Wend()
Dim x, Contador, Soma
x = 10
Contador = 1
Soma = 0
' Efetua a soma dos dez primeiros números maiores que zero.
While Contador < x
Soma = Soma + Contador
Contador = Contador + 1
Wend
MsgBox "Soma = " & Soma & " " & "Contador = " & Contador
End Sub

Faça um programa que calcule a seguinte expressão: S = X + 2 ^ N. 'Onde X e N são informados pelo usuário.

Sub lista_10()
'10) Faça um programa que calcule a seguinte expressão: S = X + 2 ^ N.
'Onde X e N são informados pelo usuário.
Dim x As Integer
Dim n As Integer
Dim s As Integer

x = CInt(InputBox(" Digite o Valor de X : "))
n = CInt(InputBox(" Digite o Valor de N : "))
s = x + 2 ^ n
MsgBox (s & "=" & x & "+ 2 ^ " & n)

End Sub

Faça uma aplicação que dado um número X [0 < X < 100]. 'Apresente em tela uma contagem regressiva de dois em dois até chegar ao número 0.

Sub lista_9()
'9) Faça uma aplicação que dado um número X [0 < X < 100].
'Apresente em tela uma contagem regressiva de dois em dois até chegar ao número 0.

Dim num As Integer
Dim i As Integer
    For i = 100 To 1 Step -1
        If (i Mod 2 = 0) Then
        Debug.Print i
        ' "Crtl G" para ver o resultado na Tela de Verificação Imediat.
        End If
    Next
End Sub

Faça uma aplicação VBA que identifique se a radiação é aceitável ou se não, em qual grupo uma determinada indústria se aplica.

Sub lista_8()
'8) A secretaria do meio ambiente que controla os índices de radiação no Japão, mantém três grupos de
'industrias que são atualmente prejudiciais ao meio ambiente. O índice de radiação aceitável varia de 0,05
'até 0,5. Se o índice variar entre 0,26 e 0,30 as indústrias do 1ºgrupo são intimadas a suspenderem suas
'atividades, se o índice variar entre 0,31 e 0,40 as industrias do 1º e 2º grupos são intimadas a
'suspenderem suas atividades, se o índice for acima de 0,41 todos os grupos devem ser notificados
'(1º,2º,3º).
'Sua tarefa: Faça uma aplicação VBA que identifique se a radiação é aceitável ou se não, em qual grupo uma
'determinada indústria se aplica.

Dim indic As Integer
Dim mensagem As String

indic = Val(InputBox("Indique Indice Radação do Momento: "))


    If (indic >= 26) And (indic <= 30) Then
        mensagem = "Suspender Atividades Das Industrias do Grupo 1"
     
    ElseIf (indic > 30) And (indic <= 40) Then
        mensagem = "Suspender Atividades Das Industrias dos Grupos 1 e 2"
 
    ElseIf (indic < 25) Then
        mensagem = "Indice Normal Sem Risco de Radiação"
 
    Else
        mensagem = "Suspender Atividades das Industrias do Grupos 1,2,3"
     
    End If
    MsgBox mensagem

End Sub

Faça um programa que mostre todos os números 'divisíveis exatos por três que estão no intervalo de 3 a111.

Sub lista_7()
'7) Faça um programa que mostre todos os números
'divisíveis exatos por três que estão no intervalo de 3 a111.

Dim selecao As Integer
Dim i As Integer

    For i = 3 To 111
        If (i Mod 3 = 0) Then
            Debug.Print i & " É Divisivel por 3 "
            '"Ctrl G" pra acessar Verificação Imediata
        End If
    Next
End Sub

Faça uma aplicação VBA que calcule o IMC da pessoa. Peso e altura da pessoa devem ser informados.

Sub lista_6()
'6) Faça uma aplicação VBA que calcule o IMC da pessoa. Peso e altura da pessoa devem ser informados.
'Fórmula: peso/(altura * altura)
Dim nome As String
Dim altura As Double
Dim peso As Double
Dim imc As Double

nome = InputBox("Digite seu Nome ")
altura = InputBox("Digite sua Altura")
peso = InputBox("Digite seu Peso")

imc = peso / (altura * altura)

    If (imc >= 20) And (imc <= 25) Then
        MsgBox (nome + Chr(13) + " Seu IMC é : " & imc & Chr(13) + "Peso Ideal")

    ElseIf (imc > 25) Then
        MsgBox (nome + Chr(13) + " IMC é : " & imc & Chr(13) + "Sobre Peso")
 
    Else
        MsgBox (nome + Chr(13) + " IMC é : " & imc & Chr(13) + "Abaixo do Peso")
    End If
End Sub

Faça uma aplicação VBA onde o usuário informa 10 números inteiros 'e ao final mostre a quantidade denúmeros maiores que 100 digitados pelo usuário.

Sub lista_5()
'5) Faça uma aplicação VBA onde o usuário informa 10 números inteiros
'e ao final mostre a quantidade denúmeros maiores que 100 digitados pelo usuário.

Dim num  As Integer
Dim i As Integer

For i = 1 To 10
 num = CInt(InputBox("Digite um numero"))
 If (num >= 100) Then
 Debug.Print num
 End If
 Next

' "Ctrl G" para visualizar a lista de numeros maiores que 100 que foram digitados

End Sub

Faça uma aplicação VBA onde o usuário entra com seu nome e a opção desejada.

Sub lista_4()
'4) Faça uma aplicação VBA onde o usuário entra com seu nome e a opção desejada.
'1- Instalar Aplicativo
'2- Fazer Beckup
'3- Restaurar Cópia
Dim opcao As String
Dim nome As String
nome = InputBox(" Olá Qual seu Nome ")

MsgBox "Opções : " + Chr(13) + Chr(13) + _
       " 1 Instalar Aplicativo" + Chr(13) + _
       " 2 Fazer Backup " + Chr(13) + _
       " 3 Restaurar Copia " + Chr(13) + _
       " Escolha a Opcao na Proxima Tela."
     
       opcao = Val(InputBox(" Digite sua Opcao "))
     
       Select Case opcao
       Case 1
       opcao = " Ola " & nome & " Voce escolheu : Instalar Aplicativo "
       Case 2
        opcao = " Ola " & nome & " Voce escolheu : Fazer Backup "
       Case 3
        opcao = " Ola " & nome & " Voce escolheu : Restaurar Copia "
       Case Else
       opcao = " Opcao Invalida "
       End Select
       MsgBox (nome & Chr(13) & " Opção Escolhida : " & opcao)
End Sub

'Faça uma aplicação VBA onde o usuário informe a data de seu nascimento e o programa exibe sua idade aproximada em anos. Dica: Use a função datediff.

Sub lista_3()
'Faça uma aplicação VBA onde o usuário informe a data de seu nascimento e o programa exibe sua idade aproximada em anos. Dica: Use a função datediff.

Dim data As Date
Dim msg As String
Dim d1, d2, d3, d4, d5 As Single

data = InputBox(" Digite a Data dd/mm/aaaa que Voce Nasceu ")
msg = " Voce tem " & DateDiff("yyyy", data, Now) & " anos"
MsgBox msg

d1 = DateDiff("d", data, Now)
d2 = DateDiff("m", data, Now)
d3 = DateDiff("yyyy", data, Now)
d4 = DateDiff("s", data, Now)

msg = " Sua idade e : " & vbCrLf
msg = msg & " ============================== " & vbCrLf
msg = msg & " Em dias : " & d1 & " dias " & vbCrLf
msg = msg & " Em meses : " & d2 & " meses " & vbCrLf
msg = msg & " Em anos : " & d3 & " anos " & vbCrLf
msg = msg & " Em segundos : " & d4 & " segundos " & vbCrLf

MsgBox msg, vbOKOnly, " calculando intervalos de datas "

End Sub

Faça uma aplicação VBA onde o usuário entre com um Número inteiro e mostre se o mesmo é divisível exato por 3.

Sub lista_2()
'2) Faça uma aplicação VBA onde o usuário entre com um número inteiro e mostre se o mesmo é divisível exato por 3.
Dim numero As Integer
Dim mensagem As String

numero = CInt(InputBox(" Digite um valor "))
    If numero Mod 3 = 0 Then
        mensagem = " O Numero " & numero & " é Divisivel por 3"
    Else
        mensagem = " O Numero " & numero & " Não é Divisivel por 3"
    End If
 
    MsgBox mensagem
End Sub

Faça uma aplicação VBA para calcular a seguinte expressão, x = a+y-7 no final, mostre o valor de x.

'1) Faça uma aplicação VBA para calcular a seguinte expressão, x = a+y-7 no final,
mostre o valor de x.

Sub lista_1()
Dim a As Integer
Dim y As Integer
Dim x As Integer

Dim mensagem As String
Dim resposta As String

a = CInt(InputBox(" Digite o Valor de A"))
y = CInt(InputBox(" Digite o Valor de Y"))

resposta = (a + y) - 7
mensagem = mensagem & "O Valor de X é : " & resposta

MsgBox mensagem

End Sub