Saberexcel - o site das macros
Esta macro do Aplicativo Microsoft Excel VBA, pergunta se voce deseja ou não inserir uma planilha personalizada com o nome formatado com data e hora atual

Sub Adicionar_planilha_com_dia_hora()

Dim Resposta As VbMsgBoxResult
Dim sht As Worksheet
Resposta = MsgBox("Deseja inserir nova planilha com o nome da data e hora atual?" _
, vbQuestion + vbYesNoCancel)
If Resposta = vbYes Then
Set sht = Worksheets.Add
sht.Name = Format(Now, "ddd-dd-mmm-yyyy_hhmmss")
ElseIf Resposta = vbNo Then
Worksheets.Add
Else
Exit Sub
End If
MsgBox "Planilha inserida com sucessso!! [ " & ActiveSheet.Name & "]", vbInformation, "http://www.saberexcel.com"
End Sub

Aplicativo Microsoft Excel VBA --(SaberExcel)--

Macro simples do Aplicativo Microsoft Excel VBA, que adiciona um cabeçalho na folha de planilha, contém também uma macro auxíliar para ajudar no teste, deletanto o cabeçalho inserido. Observe que a macro está usando a instrução For Each, isso afeta todas as planilhas do livro, então, a macro inserirá cabeçalho em todas as planilhas do livro.


Sub Inserir_cabecalho_todas_planilhas()
'Adiciona uma espécie de cabeçalho em todas planilhas.
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1").Value = "DATA"
ws.Range("B1").Value = "NOME"
ws.Range("C1").Value = "ENDEREÇO"
ws.Range("D1").Value = "CIDADE"
ws.Range("E1").Value = "C E P"
Next ws
End Sub

Sub Limpar_cabecalho_todas_planilhas()
'Adiciona uma espécie de cabeçalho em todas planilhas.
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1").Value = ""
ws.Range("B1").Value = ""
ws.Range("C1").Value = ""
ws.Range("D1").Value = ""
ws.Range("E1").Value = ""
Next ws
End Sub


Aprenda sobre o Aplicativo Microsoft Excel VBA com SaberExcel

SaberExcel - o site das macros
Essa macro do Aplicativo Microsoft Excel VBA, adiciona doze planilhas referente aos meses do ano, e deleta todas as folhas de planilhas preservando somente a folha de planilha desejada, mas na macro abaixo há uma explicação para preservar mais de uma folha de planilha na deleção. leia abaixo.

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 acaba seleciona a plan1
End Sub

Essa macro é muito útil também em outras aplicações, pois ela deleta todas as planilhas e preserva a folha de planilha desejada.
por exemplo se voce necessitar que seja preservada mais de uma planilha deverá mudar a linha de código abaixo para:

If (Plan.Name <> "Plan1" And Plan.Name <> "Janeiro") Then
Neste caso, se aumentar as planilhas a serem preservadas, tem que retirar a Folha de Planilha "Janeiro" do Array (Meses) na macro acima veja lá.
porque senão, toda a vez que inserir, a macro vai inserir uma a mais, com um determinado número, porque a folha de planilha já existe, nao foi deletada.

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

'...........................................................................'

Sub Macro3()
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

Sub Recado_p_Núbia()
Range("D17").Value = "Núbia, esta vendo o ""porque?"" da Coleção 15.000 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, pois a coleção de macros esta em programa apropriado"
Range("D23").Value = "Fique com Deus, Esforce-se!"
Range("D24").Value = "Se precisar de alguma coisa, Comunique comigo"
Range("D25").Value = "Expedito de Paula Marcondes... Excel VBA."
Range("D26").Select
End Sub

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




Publicidade
Compre com segurança, garantia e ótimos preços nas lojas SubMarino,
tudo que voce precisar poderá encontrar nas lojas submarino, livros, notebooks...

Saberexcel - o site das macros

Essas macros do Aplicativo Microsoft Excel VBA, impedem o usuário de deletar determinadas planilhas, enviando mensagem de proibição de deleção de Folha de Planilha. A macro abaixo Modificar_deletar_planilha(), tem por finalidade inserir um botão de menu à barra principal do aplicativo, no caso de estar usando Excel 2007 ou Excel 2010, na aba suplementos. (menus personalizados fica nesta Aba 'Suplementos')

Sub Modificar_deletar_planilha()
Dim sb As CommandBarControl
For Each sb In Application.CommandBars.FindControls(ID:=847)
sb.OnAction = "Deleta_Planilha"
Next sb
End Sub

Sub Deleta_Planilha()
If ActiveSheet.Index = 1 Then
MsgBox "Voce não pode deletar esta planilha!", vbc + vbOKOnly + vbExclamation, "INFORMAÇÃO AO USUÁRIO - Saberexcel.com"
Else
Select Case MsgBox("Atenção voce vai deletar essa planilha !", vbc + vbYesNo + vbExclamation, "INFORMAÇÃO AO USUÁRIO - Saberexcel.com")
Case vbYes
ActiveSheet.Delete
Case vbOK
Exit Sub
End Select
End If
Exit Sub
End Sub


Sub Reabilitar_deletar_Planilha()
Dim sb As CommandBarControl
For Each sb In Application.CommandBars.FindControls(ID:=847)
sb.OnAction = ""
Next sb
End Sub




Aprenda tudo sobre o Aplicativo Microsoft Excel VBA, praticando com os produtos didáticos SaberExcel





Publicidade:
Compre com segurança, qualidade, garantia e melhores preços nas lojas subMarino