domingo, 16 de novembro de 2008

Excel VBA Macros - Deleta linhas ou colunas em branco Planilha Excel VBA

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 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/
'...........................................'

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