Set 28

EXCEL VBA - Insere um comentário Personalizado

Comentários No Comments »

‘Esta macro insere um comentário através de uma caixa de entrada(Inputbox)
‘Macro Gentilmente enviada pelo amigo Eduardo Oliveira.
‘………………………………………….’
Sub Comentario_Personalizado()
scomentario = InputBox(”Qual o comentário a ser Inserido?”, “System @nalise”, “”)
Dim TB As TextBox
With ActiveCell
If Not .Comment Is Nothing Then .Comment.Delete
   With .AddComment(”Eduardo” & vbLf & scomentario)
       Set TB = .Shape.OLEFormat.Object
       With TB.Characters(1, 7).Font
              .Bold = True
              .Color = rgbRed
       End With
   End With
End With
End Sub
‘…………………………………’

Coleçao com 15.000 Macros Ms Excel VBA - Saberexcel

written by E. Marcondes

Nov 07

Excel VBA Macros - Esta macro deleta linhas ou colunas em branco na planilha do aplicativo MS Excel

Linhas No Comments »
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
‘……………………………..’
Coleçao com 15.000 macros MS Excel VBA  - Saberexcel
‘……………………………..’

written by E. Marcondes

Nov 07

Excel VBA Macros - célula planilha excel intermitente (piscando)

Celula Intermitente 1 Comment »
Excel VBA Macros -  esta macro faz uma configuração de cores cor colorir a célula da planilha
excel vba  e fica intermitente de acordo com as cores definidas novo  Estilo (Formatar / Estilo / Normal / Adicionar )  usando o método Application.OnTime
 
‘Exemplo de valores de ColorIndex:
‘1= Preto, 2= Branco, 3= Vermelho, 4= verde,5= Azul, 6= Amarelo
‘Combina o estilo e uma macro com metodo” Application.OnTime “
 
Sub Flash()
Dim NextTime As Date
NextTime = Now + TimeValue(”00:00:01″)
With ActiveWorkbook.Styles(”Normal”).Font
If .ColorIndex = 2 Then .ColorIndex = 3 Else .ColorIndex = 2
End With
Application.OnTime NextTime, “Flash”
End Sub
‘—-‘
Sub Parar()
Application.OnTime NextTime, “Flash”, schedule:=False
ActiveWorkbook.Styles(”Normal”).Font.ColorIndex = xlAutomatic
End Sub
‘———————‘
http://www.saberexcel.com   ( o Site das Macros)
comprar  - 15.000 Macros do Excel VBA, funções, fórmulas,
‘………………………’

written by E. Marcondes

Nov 07

Excel VBA Macros - seleciona 4 células na mesma linha e emite a mensagem indicando o endereço

Células No Comments »
 ’Estas macros seleciona 4 células na mesma linha e emite a mensagem indicando o endereço 
‘ da célula na planilha do excel vba. 
Sub Seleciona_4_Celulas_Linha_1()
  Dim Inicio As String, endereco As String
  Inicio = Selection.Address
  Range(Selection, Selection.Offset(0, 4)).Select
  endereco = Selection.Address
  MsgBox “Inicio: ” & Inicio & Chr(13) & “Endereço: ” & endereco
End Sub
‘……………………………..’
http://www.saberexcel.com
O site das Macros Excel VBA
Coleção de 15.000 Macros, Fórmulas, Funções do Aplicativo MS Excel VBA
‘……………………………’

written by E. Marcondes

Ago 27

Excel VBA Macros - insere formatacao em celulas com Zero - Ex: ( 0 ) - ( 0,00 )

Formatos No Comments »
Option Explicit
‘Excel VBA  - insere formatação na célula onde há zero,
‘por exemplo: celula B5 = 0, acionar a macro:  B5 = 0,00
‘primeiramente cor azul, posteriormente cor amarela.
Sub Insere_formatacao_no_zero()
    Dim Cel As Range, texto As Variant
    For Each Cel In Selection
        If Left(Cel.NumberFormat, 2) <> “;;” Then
            Cel.NumberFormat = “;;” & “”"” & Cel & “”"”
            Cel.Value = 0
            ‘Indica “Especial” celulas com determinado formato
            Cel.Interior.ColorIndex = 34
        Else
            texto = Split(Cel.NumberFormat, “;”)
            Cel.NumberFormat = “#,##0.00″
            Cel.Value = Mid(texto(2), 2, Len(texto(2)) - 2)
            ‘muda a cor da formatação
            Cel.Interior.ColorIndex = 6
        End If
    Next
End Sub
‘……………………………………’
Site das macros
http://www.saberexcel.com
Coleção de 15.000 Macros Excel VBA , Funções e Fórmulas, Planilhas, Dicas, Modelos Planilhas

written by E. Marcondes

Jul 10

Excel VBA Macros - Extração de número de Loto na planilha Excel

Loto No Comments »
Excel VBA - Extração de número de  Loto na planilha Excel, “Loterias”
‘=AleatórioLoto(1;49;6)  ‘ um número aleatório ate 49 6 números.
 
Function AleatorioLoto(Botao As Integer, Top As Integer, Amount As Integer)
Dim iNum As String
Dim strNum As String
Dim i As Integer
 
Application.Volatile
  iNum = Int((Top - Botao + 1) * Rnd + Botao)
 
   For i = 1 To Amount
       strNum = Trim(strNum & ” ” & iNum)
         Do Until InStr(1, strNum, iNum) = 0
           iNum = Int((Top - Botao + 1) * Rnd + Botao)
         Loop
   Next i
 
AleatorioLoto = strNum
 
End Function
‘———————————–‘
http://www.saberexcel.com/      
Site das Macros
Coleção de 15.000 Macros, Funções e Fórmulas
‘———————————–‘
 

written by E. Marcondes

Jul 10

Excel VBA Macros - Extrai seis números aleatórios, Loto Loteria

Loto No Comments »

‘Esta macro do Excel VBA extrai (6) seis números aleatórios.
‘………………….’

 Sub Loto()

Dim i, choice, balls(49)

  For i = 1 To 49

    balls(i) = i

  Next

  Randomize Timer

  For i = 1 To 6

    choice = 1 + Int((Rnd * (49 - i)))

    ActiveCell.Offset(0, i - 1).Value = balls(choice)

    balls(choice) = balls(50 - i)

  Next

End Sub
‘………………….’
Site das Macros  Excel VBA
( 15.000 Macros, Funções, Fórmulas, Blog, Apostilas, Dicas, Boletins, 5.000 Planilhas Modelos)

http://www.saberexcel.com/

‘………………………………….’

written by E. Marcondes

Jun 15

Excel VBA Macros - Insere hiperlink para navegar entre as planilhas

Hiperlinks No Comments »
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
http://www.saberexcel.com/
‘…………………………………….’   

written by E. Marcondes

Mai 31

Excel VBA Macros - Esta macro insere uma marca d’agua na Planilha

Marca d'agua No Comments »
‘Excel VBA Macros e Planilhas
‘Esta macro excel vba insere uma marca d´agua na planilha excel, com tamanho determinado
‘………………………………’
Sub Marca_Dagua()
    ActiveSheet.Shapes.AddTextEffect _
        (msoTextEffect1, “C O N F I D E N C I A L”, _
        “Algerian”, 36#, msoFalse, _
        msoFalse, 40, 300).Select
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 22
    Selection.ShapeRange.Fill.Transparency = 0.5
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse
    Selection.ShapeRange.IncrementRotation -26.69
‘    Application.CommandBars(”WordArt”).Visible = False
    Range(”A1″).Select
End Sub
‘——————————-‘
http://www.saberexcel.com
O site das Macros VBA Excel
15.000 macros, funções, fórmulas, Apostilas, Dicas, Boletins, 5.000 modelos planilhas…
‘——————————-‘

written by E. Marcondes

Mai 31

Excel VBA Macros - Envia para lixeira determinado arquivo

Lixeira No Comments »
Excel VBA Macros - Esta macro envia para lixeira o arquivo apg.xls
tem que copiar todo código - somente copiar e colar no módulo normal

Declare Function SHFileOperation Lib “shell32.dll” Alias _
“SHFileOperationA” (lpFileOp As SHFILEOPSTRUCT) As Long
 
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
 
Sub Enviar_Arquivo_Lixeira()
Lixeira_Arquivos “c:\Meus documentos\apg.xls”
End Sub
 
Sub Lixeira_Arquivos(sFile As String)
Const FO_DELETE = &H3
Const FOF_ALLOWUNDO = &H40
Dim FileOperation As SHFILEOPSTRUCT
Dim lReturn As Long
Dim sFileName As String
With FileOperation
.wFunc = FO_DELETE
.pFrom = sFile
.fFlags = FOF_ALLOWUNDO
End With
lReturn = SHFileOperation(FileOperation)
End Sub
‘……………………………….’
http://www.saberexcel.com  
( Site das macros )
15.000 macros, funções, fórmulas, dicas, apostilas, Boletins, 5.000 planilhas modelos, …
‘……………………………….’

written by E. Marcondes

Previous Entries