Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.

Este macro está ligado ao evento change da folha de planilhas, ao selecionar a data na lista suspensa,
retorna automaticamente Msgbox, mensagem data, mês, total de dias no mes, data e hora.
observe que usei a propriedade Offset(Linha, Coluna) para deslocar os dados dentro da tabela.
em nossas vídeos_Aulas "Aprendendo a programar com Simplicidade e Facilidade, Escrevendo menos e Fazendo Mais"
abordamos bem o assunto sobre o tema: Celulas(cells()) e Range(), que achamos primordial no aprendizado com programação MS Excel VBA.

Fique com Deus,
Expedito Marcondes

'- - - - - - - - - - - - - - - - - - - - -'
Sub sbx_dias_total_mes()
Data_inicio = CDate(Plan1.[c2])
Data_Teste = Data_inicio
vNum_Dias = Day(DateSerial(Year(Data_Teste), Month(Data_Teste) + 1, 1) - 1)
MsgBox "Esta data....:[ " & Plan1.Cells(2, "c") & " ]" & vbCrLf & Format(Plan1.Cells(2, "c"), "dddd") & vbCrLf & _
"Este mês ...: [ " & Month(Range("c2")) & " ] contém [ " & (vNum_Dias) & " ] dias", vbInformation, _
"Escola SaberExcel VBA Estudos®"

Range("F65000").End(xlUp).Offset(1, 0) = Plan1.[c2]
Range("F65000").End(xlUp).Offset(0, 2) = Month(Range("c2"))
Range("F65000").End(xlUp).Offset(0, 4) = (vNum_Dias)
Range("F65000").End(xlUp).Offset(0, 6) = Now()
End Sub

'Observe que inserí esse macro no Evento Change (ao escrever na folha de código da folha de Planilha)
então, ao selecionar na lista suspensa uma determinada data, retornará a mensagem e inserirá nas colunas
(Colunas(F,H,J,L) - os mesmos Data, mês da data, total de dias mês, data e hora consulta.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$2" And Target.Count = 1 Then
sbx_dias_total_mes
End If
End Sub

Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.

Macros do Aplicativo Microsoft Excel VBA, adicionam 12(doze) folhas de planilhas no livro(workbook) com os nomes dos doze meses do ano, e outra macro que deleta todas as folhas de planilha, preservando uma, a desejada.
Sub adiciona_Meses()
Dim Meses As Variant
Meses = Array("minha", "Janeiro", "Fevereiro", "Março", "Abril", "Maio", "Junho", "Julho", "Agosto", "Setembro", "Outubro", "Novembro", "Dezembro")
ActiveWorkbook.Sheets.Add , , 12
For i = 1 To 12
Sheets(i).Name = Meses(i)
Next i
Sheets("Plan1").Select ' quando encerrar a macro, seleciona a folha de planilha (Plan1)
End Sub

Esta macro é uma macro auxíliar, para ajudar no teste do aluno-desenvolvedor, que deleta todas as folhas de planilhas preservando apenas uma determinada pela macro.
Sub Deleta_todas_menos_a_desejada()
Dim Plan As Worksheet
On Error Resume Next
Application.DisplayAlerts = False 'impede de emitir a mensagem se deseja excluir
For Each Plan In Worksheets
If (Plan.Name <> "Plan1") Then
Plan.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

Núbia voce poderá conseguir selecionar todas as planilhas gravando uma macro, veja o resultado.

Sub seleciona_todas_planilhas()
Sheets(Array("Janeiro", "Fevereiro", "Março", "Abril", "Maio", "Junho", "Julho", _
"Agosto", "Setembro", "Outubro", "Novembro", "Plan1")).Select
Sheets("Janeiro").Activate
Range("J27").Select
Sheets("Plan1").Select
Range("G18").Select
End Sub

Essas informações que voce quer inserir na folha de planilha poderá ser algo mais ou menos parecido com a macro abaixo, veja:
Sub Recado_p_Núbia()
Range("D17").Value = "Esta vendo o ""porque"" da coleção de Macros"
Range("D18").Value = "é somente o código sem ter necessidade da planilha modelo"
Range("D20").Value = "já a planilha toda com o código fica mais pesado"
Range("D21").Value = "ficaria inviável"
Range("D23").Value = "Fique com Deus, Esforce-se!"
Range("D24").Value = "Se precisar de alguma coisa, Comunique comigo"
Range("D25").Value = "Expedito Marcondes... Excel VBA."
Range("D26").Select
End Sub

Macro auxiliar também para ajudar nos testes de planilha com o aluno-desenvolvedor
Sub Limpar_Recados()
Range("D17") = "" ' duas aspas sem nada significa (que não tem nada) em branco
Range("D18") = ""
Range("D20") = ""
Range("D21") = ""
Range("D23") = ""
Range("D24") = ""
Range("D25") = ""
Range("D26") = ""
End Sub

'Com este código acessa o módulo modulo vai para
Sub ver_código()
SendKeys ("%{F11}")
End Sub


Aprenda tudo sobre o Aplicativo Microsoft Excel VBA

Saberexcel - site das macros

Essas macros do Aplicativo Microsoft Excel VBA(Visual Basic Application), deletará todos os dados após determinada data,
um Loop(laço) identificará a primeira data e deletará os dados anteriores à determinada data.
Essa data será determinada por meio de uma entrada de dados (InputBox)

Sub Deletar_selecao()
For i = [A65000].End(xlUp).Row To 1 Step -1
If Application.CountA(Rows(i)) = 0 Then
Rows(i).Delete
End If
Next i
End Sub

Essa macro rola a tela até a data de hoje
vamos montar o exemplo copie os dados acima e cole na celula A1 na abertura do wkb
rolará a tela e selecionará a primeira célula com a data de hoje()

Sub auto_open()
p = Application.Match(CDbl(Date), [A1:A100], 1)
Application.Goto [A1].Offset(p - 1 + IIf(Cells(p, 1) = Date, 0, 1)), scroll:=True
End Sub

Sub localizar_data_hoje()
On Error Resume Next
Sb = Application.Match(CDbl(Date) - 1, [A1:A100], 1) 'deletará data hoje -1
Application.Goto [A1].Offset(Sb - 1 + IIf(Cells(Sb, 1) = Date, 0, 1)), scroll:=True

ActiveCell.Select
ActiveCell.Offset(-1, 0).Select
Do While IsEmpty(ActiveCell.Offset(0, 0)) = False 'faça enquanto houver dados na coluna(A)
ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Value = ""
ActiveCell.Offset(0, 2).Value = ""
ActiveCell.Offset(0, 3).Value = ""
ActiveCell.Offset(0, 4).Value = ""
ActiveCell.Offset(-1, 0).Select
Loop
' If Err <> 0 Then MsgBox "Data nao encontrada!"
End Sub

Sub Macro1()
Range("L1:L16").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E2").Activate
'SendKeys ("{Esc}")
End Sub



Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application),sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel

Escola Saberexcel VBA Estudos® - o Site de quem precisa aprender sobre Macros MS Excel VBA

Esta macro adiciona(cria) folhas de planilihas com nome dos meses do ano, concatenando com o número do mês, observe que o formato da variável
vMeses esta no formato (mmmm), que retorna o "nome" 'extenso' dos meses.
Abaixo uma macro que deleta todas as folhas de planilhas e preserva somente as folhas de planilha desejadas no livro.
Espero que o exemplo possa lhe ser útil. Fique com Deus, Expedito Marcondes.
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'

Sub sbx_gerar_planilhas_meses()
'- - - - - - - - - - - - -
'http://www.microsoftexcel.com.br
'[email protected]
'- - - - - - - - - - - - -
Dim vContador As Integer
Dim vPlanilha As Worksheet
Dim vMeses As String
' criar um contador com instrução for para repetir um determinado número de vezes
For vContador = 1 To 12

'Adiciona uma Planilha
'instrução set - (referenciar um objeto)
Set vPlanilha = Worksheets.Add(, after:=Worksheets(Worksheets.Count))

'Referenciando o mês do ano atual
vMeses = vContador & " - " & Saber1.Range("A1").Value

'Renomear a planilha que foi adicionada
On Error GoTo SaberErro:
vPlanilha.Name = vMeses & " - " & Format(vMeses, "mmmm")

Set vPlanilha = Nothing 'nothing' dessassocia um objeto de uma variável
Next vContador
Saber1.Select
MsgBox ("Todas as folhas de planilhas foram deletadas" & vbCrLf & _
"Preservando a Folha de Planilha 'Auxiliar' e Produtos_Saberexcel"), vbInformation, "Escola Saberexcel VBA Estudos®"
Exit Sub

SaberErro: ' tratando um erro:
Resposta = MsgBox("Não poderá ser criar planilhas já existentes" & vbCrLf & _
"a menos que você delete as existentes para criar novas, Deseja fazer isso?", vbYesNo, "Escola Saberexcel VBA Estudos®")
If Resposta = 6 Then
Deleta_Planilhas_Exceto_Desejada
sbx_gerar_planilhas_meses
End If
Saber1.Select
End Sub
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'
Esse macro é para auxiliar no teste com os macros acima:
'Deleta todas as folhas de planilha e preserva as desejadas.
Sub Deleta_Planilhas_Exceto_Desejada()
For Each nm In Worksheets
Application.DisplayAlerts = False 'impede de emitir a mensagem se deseja excluir
If nm.Name <> "Auxiliar" And nm.Name <> "Produtos_Saberexcel" Then
nm.Delete
End If
Next nm
MsgBox ("Todas as folhas de planilhas foram deletadas" & vbCrLf & _
"Preservando a Folha de Planilha 'Auxiliar' e Produtos_Saberexcel"), vbInformation, "Escola Saberexcel VBA Estudos®"
End Sub
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'

Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.

Saberexcel - o site de quem precisa aprender macros Microsoft Excel VBA

Esse macro do Aplicativo Microsoft Excel VBA, retorna mensagem data e horas.
Escola Saberexcel VBA Estudos® - Treinamento com Macros, Fórmulas e Funções.
http://www.microsoftexcel.com.br - http://www.saberexcel.com.br
'-----------------------------------------'
Sub Retorna_data_hora_minuto_segundo()
DataAtual = Month(Date)
NomeMes = MonthName(DataAtual, False)

vMensagem = "Ano atual:[ " & Year(Date) & " ] " & Chr(13)
vMensagem = vMensagem & "Mês atual :[ " & NomeMes & " ] " & Chr(13)
vMensagem = vMensagem & "Hoje é dia :[ " & Day(Date) & " ] " & Chr(13)
vMensagem = vMensagem & Chr(13) & "*-*-*-*-*-*-*-*--*-*-*-*-*" & Chr(13) & Chr(13)

HoraAtual = Hour(Time())
MinutoAtual = Minute(Time())
SegundoAtual = Second(Time())

vMensagem = vMensagem & "Hora atual: " & " [ " & HoraAtual & " ] " & Chr(13)
vMensagem = vMensagem & "Minuto atual: " & " [ " & MinutoAtual & " ] " & Chr(13)
vMensagem = vMensagem & "Segundo atual: " & " [ " & SegundoAtual & " ] " & Chr(13)
vMensagem = vMensagem & Chr(13) & "*-*-*-*-*-*-*-*--*-*-*-*-*" & Chr(13) & Chr(13)
vMensagem = vMensagem & Chr(13) & "Aprenda Microsoft Excel VBA com Saberexcel" & Chr(13) & Chr(13)
MsgBox vMensagem, vbInformation, "Saberexcel - o site das macros"

End Sub
'-----------------------------------------'
'Esse macro retorna uma mensagem de saudação
Sub saudacao_mensagem()
If Time$ > "18:00:00" Then
MsgBox "Boa noite, durma bem", _
vbInformation, "Saberexcel - o Site das Macros"
ElseIf Time$ > "12:00:00" Then
MsgBox "Boa tarde!", _
vbInformation, "Saberexcel - o Site das Macros"
ElseIf Time$ > "00:00:00" Then
MsgBox "Bom dia, com muita alegria!", _
vbInformation, "Saberexcel - o Site das Macros"
End If
End Sub



Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.
http://www.micrososftexcel.com.br
'


Exc