Mostrando postagens com marcador Códigos VBA. Mostrar todas as postagens
Mostrando postagens com marcador Códigos VBA. Mostrar todas as postagens

Inserindo um menu suspenso

Este código faz com que você insira uma macro em um menu suspenso, como quando você clica com o botão direito do mouse no Excel.

Menu Suspenso

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error GoTo erro
Application.CommandBars("cell").Controls("MENSAGEM").Delete
Application.CommandBars("cell").Controls("LIMPAR").Delete

Exit Sub
erro:

End Sub

Private Sub Workbook_Open()
Dim NewControl As CommandBarControl
Dim NewControl2 As CommandBarControl

Set NewControl = Application.CommandBars("cell").Controls.Add
    With NewControl
        .Caption = "MENSAGEM"
        .OnAction = "chamar"
        .BeginGroup = True
        .FaceId = 351
    End With

Set NewControl2 = Application.CommandBars("cell").Controls.Add
    With NewControl2
        .Caption = "LIMPAR"
        .OnAction = "chamar"
        .BeginGroup = True
        .FaceId = 351
    End With
End Sub

 

Voltar

Fechando o userform ao teclar ESC

Insira este código dentro o Userform e ao teclar ESC o formulário será fechado.

 

Private Sub UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 27 Then
Unload Me
End If

End Sub

 

Voltar

Criando pastas via código VBA

Este código irá ensinar como criar uma pasta via código vba.

 

Código para criar pastas

Sub Cria_Pastas()
Dim fso, f,f1,f2,f3
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.CreateFolder("c:\Nome da pasta")
   Set f1= fso.CreateFolder("c:\Nome da pasta")
   Set f2= fso.CreateFolder("c:\Nome da pasta")
   Set f3= fso.CreateFolder("c:\Nome da pasta")
   CreateFolderDemo = f.Path
   CreateFolderDemo = f1.Path
   CreateFolderDemo = f2.Path
   CreateFolderDemo = f3.Path
End Sub

 

Voltar

Código Maiusculas e Minusculas

Este código faz com que você coloque uma seleção em maiusculas ou minusculas, selecionando um intervalo o código irá transformar tudo em maiusculo ou minusculo.

 

Transformar em Maiusculo

Sub Maiusculas()
    Dim Celula As Range
    Dim xSel As Long, x  As Long
    xSel = Selection.Count
    For Each Celula In Selection
        x = x + 1
        Celula.Value = UCase(Celula.Text)
    Next
End Sub

 

Transformar em Minusculo

Sub Minusculas()
    Dim Celula  As Range
    Dim xSel As Long, x  As Long
    xSel = Selection.Count
    For Each Celula In Selection
        x = x + 1
        Celula.Value = LCase(Celula.Text)
    Next
End Sub

 

Voltar

Abrindo página da intenet via código

O código abaixo mostra como abrir uma página da internet no seu navegador padrão usando um código bastante simples.

 

Insira no módulo ou formulário o código abaixo:

Sub Nome_da_Macro()

ActiveWorkbook.FollowHyperlink “http://www.google.com

End Sub

 

Voltar

Abrindo uma planilha via Código VBA

O código abaixo mostra de forma simples como abrir um planilha usando código VBA.

 

No módulo ou formulário insira o código abaixo:

Sub nome_da_macro()
Workbooks.Open FileName:=”c:\pasta1.xls”
End Sub

 

Voltar

Abrir arquivo usando InputBox

O código abaixo mostra como abrir um arquivo xls usando uma inputbox.

 

Insira no formulário ou no módulo o código abaixo:

Dim Nome As String
Sub Nome_da_Macro()
Nome = InputBox("Digite o nome", "aviso")
' Verifica se campo está em branco
If Nome = "" Then
Exit Sub
End If
If Nome <> "" Then
    ChDir "C:\Documents and Settings\Usuario\Desktop"
Workbooks.Open Filename:=Nome
End If
End Sub

 

Voltar

Carregar caminho do arquivo usando GetOpenFilename

O código abaixo mostra como inserir na planilha o caminho completo de um determinado arquivo, como no exemplo abaixo em txt usando o metodo GetOpenFilename que é aquela janela de abrir arquivos do windows.

 

Insira no módulo ou no formulário o código abaixo:

Dim QualArquivo
QualArquivo = Application.GetOpenFilename("Arquivos de texto (*.txt),*.txt", , "NINJAS DO EXCEL - Escolha o arquivo para Abrir") 'Caixa de Dialogo Abrir
Plan1.Range("A1") = QualArquivo

 

O código acima pode ser usado também para carregar arquivos em xls ou qualquer outra extensão basta mudar para xls onde estiver txt ou a outra extensão que desejar. Ao clicar sobre o arquivo na janela será inserido na Plan1 na célula A1 o caminho completo do arquivo selecionado.

 

Voltar

 

Abrindo a calculadora do windows via código VBA

Este código mostra de forma simples como abrir a calculadora do windows via código VBA, o código é bem simples mais pode servir para alguma aplicação que precise da calculadora.

 

Crie um módulo ou em algum botão do formulário insira o código abaixo:

Sub Abrir_Calculadora()
Application.ActivateMicrosoftApp Index:=0
End Sub

 

 

Voltar

Impedindo fechar o formulário no [X]

Este código mostra como fazer com que o formulário não seja fechado pelo ‘X’ e sim por algum botão específicio.

 

Clique duas vezes no formulário e insira o código abaixo:


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' Evita que o usuário feche a tela no 'x' na tela
    If CloseMode = vbFormControlMenu Then
        MsgBox "Use o Botão Fechar!!!"
Cancel = True
    End If
End Sub

 

Para fechar o formulário insira o código abaixo em algum botão.

Private Sub CommandButton1_Click()
Unload UserForm1
End Sub

 

Voltar

Inserindo Mascaras de data e hora

Este código faz com que ao ser digitado um valor de hora ou data em um textbox seja inserido automaticamente os ":" em caso de hora ou a "/" em caso de data.

 


Máscara para Hora
TextBox1.MaxLength = 5
If Len(TextBox1) = 2 Then
TextBox1.Text = TextBox1.Text & ":"
SendKeys "{End}", True
End If

 


Máscara para Data
TextBox2.MaxLength = 10
If Len(TextBox2) = 2 Then
TextBox2.Text = TextBox2.Text & "/"
SendKeys "{End}", True
End If
If Len(TextBox2) = 5 Then
TextBox2.Text = TextBox2.Text & "/"
SendKeys "{End}", True
End If

 

Voltar

Comando de Busca no Userform

Este código faz uma busca na planilha e retorna o valor ao userform conforme é indicado para planilha onde é necessário fazer buscas em bancos de dados com grande quantidade de informações e também fazer alterações no valor encontrado.


With Plan1.Range("A:A")
Set C = .Find(TextBox1.Value, LookIn:=xlValues, LOOKAT:=xlWhole)
If Not C Is Nothing Then
TextBox2.Text = C.Offset(0, 1)
TextBox3.Text = C.Offset(0, 2)
TextBox4.Text = C.Offset(0, 3)
TextBox5.Text = C.Offset(0, 4)
End If
If C Is Nothing Then
MsgBox "Nome Não Encontrado!!!"
End If
End With

 

Voltar

CÓDIGOS VBA

DESCRIÇÃO DO CÓDIGO
Abrindo a Calculadora do Windows via código VBA
Abrindo página da intenet via código
Abrindo uma planilha através de uma macro
Abrir arquivo usando InputBox
Carregar caminho do arquivo usando GetOpenFilename
Comando de Busca no Userform
Criando Pastas Via Código
Fechando o userform com a tecla ESC
Impedindo Fechar no [x]
Inserindo Mascara no Textbox
Inserindo um Menu Suspenso
Maiusculas e Minusculas