Saberexcel.com

EXCEL VBA - Insere um comentário Personalizado

E. Marcondes — Mon, 28 Sep 2009 21:18:34 +0000

‘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

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

E. Marcondes — Fri, 07 Nov 2008 10:16:14 +0000

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

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

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

E. Marcondes — Fri, 07 Nov 2008 09:56:09 +0000

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,
‘………………………’

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

E. Marcondes — Fri, 07 Nov 2008 09:48:10 +0000

’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

‘……………………………’

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

E. Marcondes — Wed, 27 Aug 2008 13:42:45 +0000

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

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

E. Marcondes — Thu, 10 Jul 2008 19:15:26 +0000

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

‘———————————–‘

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

E. Marcondes — Thu, 10 Jul 2008 19:05:17 +0000

‘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

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)

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/

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

Excel VBA Macros - Insere hiperlink para navegar entre as planilhas

E. Marcondes — Sun, 15 Jun 2008 11:47:29 +0000

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/
‘…………………………………….’

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

E. Marcondes — Sat, 31 May 2008 19:08:07 +0000

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

‘——————————-‘

Excel VBA Macros - Envia para lixeira determinado arquivo

E. Marcondes — Sat, 31 May 2008 18:20:44 +0000

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, …
‘……………………………….’