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 - 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

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

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.

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

Essa macro e Função personalizada do Aplicativo Microsoft Excel VBA(Visual Basic Application), verifica e retorna o total de dias úteis entre um intervalo de duas datas, dias úteis de trabalho. Baixe o exemplo de planilha para melhor visualizar os macros e a função personalizada, para esse cálculo de datas úteis sem os sábados e domingos através do VBA.

'Este módulo irá Dias Calcular atividade úteis entre duas datas dadas em formato abaixo.
'ColA Col B ColC
'DataIncial DataFinal Resultado nas (Celulas em branco)


Sub Calcular_dias_atividade()
[A1:B12].Select
Dim vCelulas As Range
For Each vCelulas In Selection.Cells
If IsDate(vCelulas.Value) And IsDate(vCelulas.Offset(0, 1).Value) And IsEmpty(vCelulas.Offset(0, 2)) Then
vCelulas.Offset(0, 2).Value = Dias_de_trabalho(vCelulas.Value, vCelulas.Offset(0, 1).Value)
End If
Next
[D1].Select
End Sub

Function Dias_de_trabalho(ByVal vDataInicial As Long, ByVal vDataFinal As Long) As Long
' Retorna a contagem de dias entre vDataInicial - vDataFinal menos sábados e domingos
Dim vDia As Long, vContador As Long
For vDia = vDataInicial To vDataFinal
If Weekday(vDia, vbMonday) < 6 Then
vContador = vContador + 1
End If
Next vDia
Dias_de_trabalho = vContador
End Function

'
macros abaixo foram feitas para ajudar no teste de planilha.

Sub limpar_teste()
[C2:C15].ClearContents
[D1].Select
End Sub

Sub visualizar_macros_vbe()
Dim Resposta As String

Resposta = MsgBox("Deseja visualizar as macros no módulo VBE?", vbYesNo, "Saberexcel - o site das macros")
If Resposta = 6 Then ' 6 é igual a vbyes
Application.Goto reference:="Dias_de_trabalho"
Else
Saber1.Shapes("sb").Visible = True
End If

End Sub

Sub oct()
Saber1.Shapes("sb").Visible = False
End Sub

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