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

'Verificar se um Numero é divisivel por 3 " (mod 3 = 0) "

Sub procMult3()
'Verificar se um numero é divisivel por 3 " (mod 3 = 0) "
Dim num As Integer
Dim mensagem As String
   num = Val(InputBox("Escreva um Numero", "Número num"))
 
   If (num Mod 3 = 0) Then
    mensagem = "Numero é Multiplo de (3) TRES   "
   Else
    mensagem = "Não é Multiplo de (3) TRES  "
   End If
    MsgBox mensagem & num
End Sub

'Função ("For To, "IF Then Else End If",Next) Verifica lista de 5 Numeros se Par ou Impar

Sub procSelecImpar()
'Função "For To"  "IF Then Else End If", Verifica lista de 5 numeros se par ou impar
    Dim num As Integer
    Dim i As Integer
        For i = 1 To 5
        num = CInt(InputBox("digite o numero"))
            If (num Mod 2 = 0) Then
            Debug.Print num & " É par "
            Else
            Debug.Print num & " É Impar "
            End If
        Next
End Sub

'Varias Função (IF Then Else End If), Verifica lista de 5 Numeros se Par ou Impar

Sub procExer4()
'Varias Função IF Then Else End If, Verifica lista de 5 numeros se par ou impar
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim numero As Integer
Dim mensagem As String

    a = Val(InputBox("Escreva um Numero", "Número a"))
    b = Val(InputBox("Escreva outro Numero", "Número b"))
    c = Val(InputBox("Escreva outro Numero", "Número C"))
    d = Val(InputBox("Escreva um Numero", "Número d"))
    e = Val(InputBox("Escreva outro Numero", "Número e"))
 
'Verifica se "a" é par ou impar
    numero = a
    If (numero Mod 2 = 0) Then
        mensagem = "Numero é Par  "
    Else
        mensagem = "Numero é Impar  "
    End If
    MsgBox mensagem & numero
 
'Verifica se "b" é par ou impar
     numero = b
    If (numero Mod 2 = 0) Then
        mensagem = "Numero é Par  "
    Else
        mensagem = "Numero é Impar  "
    End If
    MsgBox mensagem & numero
 
'Verifica se "c" é par ou impar
     numero = c
    If (numero Mod 2 = 0) Then
        mensagem = "Numero é Par  "
    Else
        mensagem = "Numero é Impar  "
    End If
    MsgBox mensagem & numero
 
'Verifica se "d" é par ou impar
     numero = d
    If (numero Mod 2 = 0) Then
        mensagem = "Numero é Par  "
    Else
        mensagem = "Numero é Impar  "
    End If
    MsgBox mensagem & numero
 
'Verifica se "e" é par ou impar
     numero = e
    If (numero Mod 2 = 0) Then
        mensagem = "Numero é Par  "
    Else
        mensagem = "Numero é Impar  "
    End If
    MsgBox mensagem & numero
 
End Sub

'Função (If And Then, ElseIf, Else, End If) Verifica entre 3 numeros o Maior.

Sub procMaior_Tres()
'Função If And Then, ElseIf, Else Verifica entre 3 numeros o Maior.
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim maior As Integer
    a = Val(InputBox("Escreva um Numero", "Número a"))
    b = Val(InputBox("Escreva outro Numero", "Número b"))
    c = Val(InputBox("Escreva outro Numero", "Número C"))
 
     If (a > b) And (a > c) Then
        maior = a
        ElseIf (b > c) Then
            maior = b
        Else
            maior = c
     End If
     MsgBox " O Maior é :  " & maior
End Sub