Excel VBA Macros - Esta macro deleta linhas ou colunas em branco na planilha
do aplicativo MS Excel
'...........................................'
Sub Deleta_Linhas_Branco()
Sheets(”SuaPlanilha”).Select
Dim r, c, x As Integer
‘r esta é sua primeira linha na planilha excel
For r = 1 To 150
‘c é seu loop da primeira coluna da planilha excel até que c alcance 184 (improváveis)
For c = 1 To 184
’se a celula do excel determinada no loop estiver em branco
If Cells(r, c) = “” Then
‘procura proxima linha não branca - o número de coluna transformar-se-á x
x = Cells(r, c).End(xlToRight).Column
‘if x > 184 (sua ultima coluna) então você pode pular o pause desta lista como espaço em branco
If x > 184 Then GoTo 10
‘encontre o que a coluna antes da lista não-em branco faz o seguinte:
Y = x - 1
‘Teste a diferença entre a coluna que estão sendo processados e o y
Select Case Y - c
’se mais de uma lista atual no meio da lista em branco e não contiver espaço em branco seguinte suprimem então 'da escala dos espaços em branco
Case Is > 0
Range(Cells(r, c), Cells(r, Y)).Delete Shift:=xlToLeft
Case 0
’se diferença entre o & de y; c é 0 então somente uma Lista a Suprimir
Cells(r, c).Delete Shift:=xlToLeft
Case Else
’se it’ negativo de s você tem um erro!!
MsgBox “Error: Macro Will Stop”, vbCritical, “Error”
Exit Sub
End Select
End If
‘move para a proxima coluna
Next c
‘ 10 é usado como um atalho para interromper o loop acima… se 10 entende que estão toda em branco - o trabalho 'de deleção vai apenas para a lista seguinte ao 10
Next r
End Sub
'.....................................'
http://ww.saberexcel.com
o site das macros do Aplicativo MS Excel VBA Visual Basic Application
Coleção de 15.000 Macros, Fórmulas e Funções
'....................................'
Excel VBA Estudos, planilhas vba, macros planilhas, downloads planilhas, apostilas, dicas excel, funções, fórmulas, modelos excel, excel vba macros, planilhas contas, controle de estoque, orçamentos,
domingo, 16 de novembro de 2008
':........................................................ ><((((º>
'Excel VBA Macros - Esta macro insere hiperlink na planilha um para navegar para outras planilhas.
'.......................................................'
Sub Lista_nome_das_planilhas_em_hyperlinks()
'.......................................................'
On Error Resume Next
Sheets.Add.Name = "Lista_Planilhas"
Sheets("Lista_Planilhas").Move Before:=Sheets(1)
Dim Minhas_Planilhas As Worksheet
Dim x As Integer
x = 1
For Each Minhas_Planilhas In Worksheets
Cells(x, 1).Select
ActiveCell = Minhas_Planilhas.Name
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", _
SubAddress:="'" & ActiveCell.Value & "'!A1" 'modif. 1
'SubAddress:=Chr(39) &ActiveCell.Value & Chr(39) & "!A1" 'modif. 2
'SubAddress:=ActiveCell.Value & "!A1"
x = x + 1
Next Minhas_Planilhas
x = 1
End Sub
'............................................'
O Site das macros Excel VBA Fórmulas e Funções
Coleção de 15.000 Macros, Funções e Fórmulas
http://www.saberexcel.com/
'...........................................'
Marcadores:
Hiperlinks
Excel VBA Macros - Mudar a hora do sistema do computador
’Esta macro do Aplicativo Ms Excel emite uma mensagem, para mudar a hora do sistema - 'pergunta se deseja ou 'não alterar a hora do sistema de seu computador sim ou não resposta'.........................................'
Sub Mudar_data_Sistema()
Dim DATANOVA As Variant
If MsgBox("- Data do sistema: " & ; Format(Date, "dddddd") & Chr(10) & Chr(13) & "- Deseja Alterar?", 36, "Data Atual - Excel VBA Estudos®") = 6 Then
DATANOVA = InputBox("- Digite a nova data no formato dd/mm/aaaa ou pressione Enter para mantê-la")
If IsDate(DATANOVA) Then
Date = DATANOVAEnd IfEnd IfEnd Sub'.............................................'http://www.saberexcel.com
o Site das macros
Coleção de 25.000 Macros, Funções e Fórmulas do Aplicativo Excel VBA
'.....................................'
Sub Mudar_data_Sistema()
Dim DATANOVA As Variant
If MsgBox("- Data do sistema: " & ; Format(Date, "dddddd") & Chr(10) & Chr(13) & "- Deseja Alterar?", 36, "Data Atual - Excel VBA Estudos®") = 6 Then
DATANOVA = InputBox("- Digite a nova data no formato dd/mm/aaaa ou pressione Enter para mantê-la")
If IsDate(DATANOVA) Then
Date = DATANOVAEnd IfEnd IfEnd Sub'.............................................'http://www.saberexcel.com
o Site das macros
Coleção de 25.000 Macros, Funções e Fórmulas do Aplicativo Excel VBA
'.....................................'
Assinar:
Postagens (Atom)