Como Carregar Imagens Dentro da Propria Planilha

Recentemente eu recebi o seguinte e-mail: “ Como carregar imagens dentro da propria planilha ??”. Então…

“Há muito tempo em uma galáxia muito distante…”

Essa é uma dúvida que atormenta vários entusiastas em VBA! E aqui você vai conseguir achar sua resposta.
Logo se você estava tentando saber como passar seu sistema para o cliente com as imagens (loadpicture) dentro da própria planilha chegou uma nova esperança!

 

Passo 1 – Faça seu formulário:

 

Conforme a imagem acima pegue a sua “Caixa de Ferramentas” e crie um “Controle de Imagem” e não esqueça de dar um nome (Name), pois vamos utiliza-lo mais tarde
Como exemplo você pode usar Image1

 

Passo 2 – Função API

 

Essa função API é o grande trunfo para a funcionalidade de carregar imagens Dentro da Propria Planilha , esta foi desenvolvida pelo Stephen Bullen.
Copie o código abaixo, crie um módulo em seu projeto vba e cole na integra.

Option Explicit
Option Compare Text

''' User-Defined Types for API Calls

'Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

'Declare a UDT to store the bitmap information
Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

'''Windows API Function Declarations

'Does the clipboard contain a bitmap/metafile?
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long

'Open the clipboard to read
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

'Get a pointer to the bitmap/metafile
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long

'Close the clipboard
Private Declare Function CloseClipboard Lib "user32" () As Long

'Convert the handle into an OLE IPicture interface.
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

'Create our own copy of the metafile, so it doesn't get wiped out by subsequent clipboard updates.
Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long

'Create our own copy of the bitmap, so it doesn't get wiped out by subsequent clipboard updates.
Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long

'The API format types we're interested in
Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const CF_ENHMETAFILE = 14
Const IMAGE_BITMAP = 0
Const LR_COPYRETURNORG = &H4
Function PastePicture(Optional lXlPicType As Long = xlPicture) As IPicture

'Some pointers
Dim h As Long, hPicAvail As Long, hPtr As Long, hPal As Long, lPicType As Long, hCopy As Long

'Convert the type of picture requested from the xl constant to the API constant
lPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)

'Check if the clipboard contains the required format
hPicAvail = IsClipboardFormatAvailable(lPicType)

If hPicAvail <> 0 Then
'Get access to the clipboard
h = OpenClipboard(0&)

If h > 0 Then
'Get a handle to the image data
hPtr = GetClipboardData(lPicType)

'Create our own copy of the image on the clipboard, in the appropriate format.
If lPicType = CF_BITMAP Then
hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
Else
hCopy = CopyEnhMetaFile(hPtr, vbNullString)
End If

'Release the clipboard to other programs
h = CloseClipboard

'If we got a handle to the image, convert it into a Picture object and return it
If hPtr <> 0 Then Set PastePicture = CreatePicture(hCopy, 0, lPicType)
End If
End If

End Function

Private Function CreatePicture(ByVal hPic As Long, ByVal hPal As Long, ByVal lPicType) As IPicture

' IPicture requires a reference to "OLE Automation"
Dim r As Long, uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture

'OLE Picture types
Const PICTYPE_BITMAP = 1
Const PICTYPE_ENHMETAFILE = 4

' Create the Interface GUID (for the IPicture interface)
With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With

' Fill uPicInfo with necessary parts.
With uPicInfo
.Size = Len(uPicInfo) ' Length of structure.
.Type = IIf(lPicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE) ' Type of Picture
.hPic = hPic ' Handle to image.
.hPal = IIf(lPicType = CF_BITMAP, hPal, 0) ' Handle to palette (if bitmap).
End With

' Create the Picture object.
r = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)

' If an error occured, show the description
If r <> 0 Then Debug.Print "Create Picture: " & fnOLEError(r)

' Return the new Picture object.
Set CreatePicture = IPic

End Function
Private Function fnOLEError(lErrNum As Long) As String

'OLECreatePictureIndirect return values
Const E_ABORT = &H80004004
Const E_ACCESSDENIED = &H80070005
Const E_FAIL = &H80004005
Const E_HANDLE = &H80070006
Const E_INVALIDARG = &H80070057
Const E_NOINTERFACE = &H80004002
Const E_NOTIMPL = &H80004001
Const E_OUTOFMEMORY = &H8007000E
Const E_POINTER = &H80004003
Const E_UNEXPECTED = &H8000FFFF
Const S_OK = &H0

Select Case lErrNum
Case E_ABORT
fnOLEError = " Aborted"
Case E_ACCESSDENIED
fnOLEError = " Access Denied"
Case E_FAIL
fnOLEError = " General Failure"
Case E_HANDLE
fnOLEError = " Bad/Missing Handle"
Case E_INVALIDARG
fnOLEError = " Invalid Argument"
Case E_NOINTERFACE
fnOLEError = " No Interface"
Case E_NOTIMPL
fnOLEError = " Not Implemented"
Case E_OUTOFMEMORY
fnOLEError = " Out of Memory"
Case E_POINTER
fnOLEError = " Invalid Pointer"
Case E_UNEXPECTED
fnOLEError = " Unknown Error"
Case S_OK
fnOLEError = " Success!"
End Select

End Function

 

Passo 3 – Carregar Imagens Dentro da Propria Planilha

 

Insira uma guia em sua planilha e cole as imagens que você irá usar.
Agora nomeie a sua nova guia, como exemplo eu usei “Produtos”
Nomeie também as imagens que você colou em sua planilha.

 

 

Passo 4  – Usando a “força”: Formulário + Imagem

 

Agora criem um botão em seu formulário e clique duas vezes para inserir o código abaixo:

Private Sub CommandButton1_Click()

   Worksheets("Produtos").Shapes("bb-8").CopyPicture
   Set Image1.Picture = PastePicture(xlPicture)

End Sub

Observem que para funcionar é muito importante os nomes utilizados:

• Primeiro para localizar a imagem precisamos do nome da guia e nome da imagem
• Em segundo precisamos do nome do controle de imagem no formulario (passo1)

 

Vídeo com Detalhes

Para ver detalhes de como carregar imagens dentro da propria planilha veja o vídeo! Ah e se gostaram não esqueçam de curtir e espalhar para os amigos!!!

 

 

 

Validar e Formatar CPF compacto e funcional

Você já precisou de código para validar e formatar CPF? Caso sua resposta seja afirmativa você já deve ter encontrado centenas pela internet! E infelizmente são:

• Códigos grandes
• Não diz o que faz cada passo
• Não diz como implementar
• E o conceito está complexo

 

Então como sempre quero ajudar e inovar!!  Não sei se irei conseguir abranger toda a lista acima, mas este será meu objetivo neste artigo.

 

 

Pra que Validar e Formatar CPF ??

 

 

Uma das principais funções de um sistema (veja como criar um) é a validação dos dados antes de  gravá-los.

Devemos lembrar dos diversos cadastros de clientes que utilizam do CPF ou RG para encontrar seus clientes e sem um número válido sua base de dados está correndo risco.

 

Entendendo o código

 

Para entender o conceito é ideal que vejam o vídeo, mas mesmo assim tentarei explicar por aqui.

Em um número de CPF os dois últimos dígitos são os números verificadores. Estes são responsáveis para informar se a sequencia está correta e baseado nisso:

 

Para o DV1 (primeiro digito verificador) vamos:

• Multiplicar todos os números que compõem o CPF (com exceção dos dois dígitos verificadores) por usas respectivas posições
• Somar o resultado
• Dividir por 11 (total de dígitos) e pegar o resto

Que deve ser igual ao primeiro digito verificador do CPF (ver primeiro quadro amarelo).

 

Para o DV2 (segundo digito verificador) vamos:

• Desconsiderar a primeira posição
• Multiplicar todos os números que compõem o CPF (com exceção do último digito verificador) por usas posições – 1
• Somar o resultado
• Dividir por 11 (total de dígitos) e pegar o resto

Que deve estar idêntico ao segundo digito verificador do CPF (ver segundo quadro amarelo)

Observação: No cálculo de ambos dígitos verificadores se o resto for igual a 10, então vamos considerar como zero

 

Código vba de cpf super compacto

 

Para Validar e Formatar CPF o código abaixo está dividido em duas partes: pré-formatação e validação:

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
   numCPF = TextBox1.Value
   numCPF = Replace(numCPF, ".", "")
   numCPF = Replace(numCPF, "-", "")
   If Val(numCPF) = 0 Or validaCPF(numCPF) <> "OK" Then
      TextBox2.Value = "cpf invalido"
      Exit Sub
   Else
      TextBox1.Value = Left(numCPF, 3) & "." & Mid(numCPF, 4, 3) & "." & Mid(numCPF, 7, 3) & "-" & Right(numCPF, 2)
      TextBox2.Value = "cpf válido"
   End If
End Sub
 
Function validaCPF(numCPF)
   If Len(numCPF) < 11 Then numCPF = String(11 - Len(numCPF), "0") & numCPF
   For caracter = 1 To 9
        DV1 = Val(Mid(numCPF, caracter, 1)) * caracter + DV1
        If caracter > 1 Then DV2 = Val(Mid(numCPF, caracter, 1)) * (caracter - 1) + DV2
   Next
   DV1 = Right(DV1 Mod 11, 1)
   DV2 = Right((DV2 + (DV1 * 9)) Mod 11, 1)
   If Mid(numCPF, 10, 1) = DV1 And Mid(numCPF, 11, 1) = DV2 Then validaCPF = "OK"
End Function

 

Entenda mais: veja o vídeo

Programar Abertura de Planilha Automaticamente

Como programar abertura de planilha automaticamente? Essa é uma pergunta constante nos sites de ajuda VBA.
Tanto que quando recebo e-mails sobre esse assunto até dou duas opções:

• Executar o excel automaticamente por código vba
• Abrir o excel automático pelo agendador do Windows

Neste artigo vamos ver a segunda opção, pois a primeira pode ser vista em outros sites e apesar de ser mais simples é necessário que o processo do Excel fique aberto.

Você irá perceber que para funcionar quase não precisa de código, mas como envolve uma quantidade de passos eu coloquei várias imagens!

 

É muita tecnologia?!

 

Então antes de continuar detalhando sobre o assunto, é de convir, mesmo nunca tendo feito este código, que a idéia é muito interessante…

Deixar o Excel tão automático que não é preciso nem abrir!!!

E podemos expandir ainda mais a partir do assunto principal:

• Abrir periodicamente: diário, semanal, mensal
• Repetidamente conforme minutos ou horas
• Ao inicializar o computador
• E etc

 

Programar abertura de planilha

 

Antes de descrever cada passo é necessário enxergarmos o processo como um todo:

 

 

Etapa 1 dentro do Excel – Código Principal

 

Então vamos começar pelo fim do processo ou seja, com o código principal. Para fins didáticos meu procedimento será apenas uma mensagem.

Então irei criar um módulo conforme imagem abaixo.

Aperte ALT + F11 em sua planilha e clique com botão direito em cima da Plan1 e selecione Inserir > Módulo

 

 

 

Dentro deste módulo (tela branca que irá aparecer) vou inserir minha funcionalidade principal:

 

Sub EXECUTAR_AUTOMATICO()

   'MEU CÓDIGO PRINCIPAL
   MsgBox "Olá Bem vindos ao ExceleVBA.com.br"

   'CÓDIGO PARA FECHAR PLANILHA APÓS EXECUTAR
   Application.DisplayAlerts = False
   Application.Quit

End Sub

Importante: Perceba que nas linhas acima eu programei para o Excel fechar após realizar sua principal função. Isso é necessário para não ficar nenhum processo aberto do Excel.

 

 

Etapa 2 dentro do Excel – Código Secundário

 

 

Este procedimento irá executar assim que abrir a planilha e é responsável por chamar o procedimento principal.

Então vamos dar dois cliques onde diz EstaPasta_de_trabalho e inserir o código abaixo:

 

Private Sub Workbook_Open()

   Call EXECUTAR_AUTOMATICO

End Sub

 

Percebam que EXECUTAR_AUTOMATICO é o nome do código principal feito na etapa 1.

Agora é necessário salvar a planilha, no meu caso vou chamar de Plan_Automatica.xls

Importante: Sempre que precisei eu usei a extensão .xls. Ao fazer testes com xlsm o agendador não abriu/executou a planilha.

 

 

Etapa 3 no Windows – Agendador de Tarefas

 

 

Usando o Windows 7, 8 ou 10 você pode apertar no teclado a tecla Windows e digitar “agendador de tarefas”.

 

Assim que você clicar no “Agendador de Tarefas” irá abrir uma tela como imagem abaixo:

 

 

No menu da direita selecione a opção “Criar tarefa…”

Na próxima tela que abrir preencha os dados conforme os campos marcados na imagem abaixo.

 

 

Em seguida selecione a guia “Disparadores” e clique em “Novo”. Nesta tela vamos marcar qual a frequência que nossa planilha automática irá abrir.

 

 

Então nesta imagem eu selecionei os campos necessários para repetir a execução da planilha uma vez a cada dia iniciando as 23h.

Agora na próxima guia “Ações” vamos indicar o que desejamos abrir. Então clique em “Novo” e demonstre onde a sua planilha está salva!

 

 

Observação: Se o seu Windows for 64 bits e o seu excel for 32 bits então no campo do endereço do programa adicione o seguinte código:

%systemroot%\Syswow64\cmd.exe /C “endereço da planilha”

Dúvida ver vídeo explicativo.

A guia seguinte é a “Condições” e esta podemos pular (mas é bom você dar uma olhada).

E a última guia é a “Configurações” e é interessante você olhar o último campo que pergunta o que fazer caso o processo do Excel ainda esteja aberto (lembra que na etapa 1 nós fechamos o Excel)

 

 

E com isto finalizamos os passos para programar abertura de planilha automaticamente.

Agora é só curtir e caso tenha dúvidas veja o vídeo!

 

Vídeo Explicativo

 

Formato moeda no textbox enquanto digita

Este código formato moeda no textbox enquanto você digita funciona da mesma maneira do caixa eletrônico ou internet banking.

O visual do seu formulário vai mudar completamente com esta funcionalidade de interação com a pessoa que digita os valores monetários.

.

História do formato moeda no textbox?

 

Estava conversando com um amigo e o mesmo estava reclamando que não havia nada na internet em VBA que ajudasse para formatar o textbox enquanto digita.

Quando achava algo parecido era depois que a pessoa saia do campo ou em outra linguagem.

Então para ajudar resolvi eu mesmo fazer, ou seja, como vários outros códigos você só encontra aqui.

 

Mas afinal pra que serve isso?

 

E para quem ainda não entendeu basta dizer que o separador das casas (1000.)  e a vírgula aparece automaticamente enquanto digita, sem precisar sair do textbox para visualizar a mudança

Código para copiar

 

Sub formataMoeda()
    valor = TextBox1.Value
    If IsNumeric(valor) Then
        If InStr(1, valor, "-") >= 1 Then valor = Replace(valor, "-", "") 'retira sinal negativo
        If InStr(1, valor, ",") >= 1 Then valor = CDbl(Replace(valor, ",", "")) 'retirar a virgula
        If InStr(1, valor, ".") >= 1 Then valor = Replace(valor, ".", "") 'para trabalhar melhor retiramos ponto
        Select Case Len(valor) 'verifica casas para inserção de ponto
            Case 1
            numPonto = "00" & valor
            Case 2
            numPonto = "0" & valor
            Case 6 To 8
            numPonto = Left(valor, Len(valor) - 5) & "." & Right(valor, 5)
            Case 9 To 11
            numPonto = inseriPonto(8, valor)
            Case 12 To 14
            numPonto = inseriPonto(11, valor)
            Case Else
            numPonto = valor
        End Select
        numVirgula = Left(numPonto, Len(numPonto) - 2) & "," & Right(numPonto, 2)
        TextBox1.Value = numVirgula
    Else
        If valor = "" Then Exit Sub
        MsgBox "Número invalido", vbCritical, "Caracter Invalido"
        Exit Sub
    End If
End Sub


Function inseriPonto(inicio, valor)
    I = Left(valor, Len(valor) - inicio)
    M1 = Left(Right(valor, inicio), 3)
    M2 = Left(Right(valor, 8), 3)
    F = Right(valor, 5)
    If (M2 = M1) And (Len(valor) < 12) Then
    inseriPonto = I & "." & M1 & "." & F
    Else
    inseriPonto = I & "." & M1 & "." & M2 & "." & F
    End If
End Function

Confesso que me diverti neste exemplo de VBA, fiz até para versão de Excel 2003!

E se vocês olharem bem na verdade é um código que trabalha com texto, um assunto bem trabalhado no ebook.

O código está pronto para ser utilizado! Agora é com você, se gostou então de uma “curtida” e/ou compartilhe.

Talvez você também ache interessante saber sobre Valores Monetários por Extenso , e neste artigo disponibilizei duas planilhas para download.

Segue vídeo explicativo

 

Inserir dados do Excel para o Access com Vba

 

Atualmente no site existe um artigo descrevendo como consultar dados do Access para o Excel (que por sinal é bem interessante) e resolvi complementar para aqueles que são amantes de usar o excel somente como interface.

Existe diversas formas de fazer esta inserção, mas acredito que esta seja uma das mais simples.

Com este artigo você poderá inserir dados do Excel para o Access e assim poderá ter todo um histórico de informações e consultas. Dependendo da situação nada melhor que salvar os dados em um banco de dados (ou melhor um: sgbd).

 

Primeiro Passo: Informações de diretório

 

O arquivo de banco de dados deve ficar dentro de uma pasta chamado: base
A pasta base deve ficar no mesmo diretório da planilha

 

Segundo Passo: Criação do banco no Access

 

Para este artigo criei uma tabela simples com as seguintes informações:

Campos: Nome, Idade, Profissao e Cidade
Nome Tabela: TB_dados_pessoais
Nome banco: BD_dados.mdb

 

Obs.: É muito importante que neste exemplo de código você salve como .mdb

 

Terceiro: Biblioteca Excel

 

Primeiro é necessário marcar algumas bibliotecas para o código funcionar, portanto segue os passos abaixo:

Alt + F11 > Ferramentas > referências > marcar Microsoft Active data Objects

 

Quarto Passo: Interface Excel

 

Os campos na planilha são os mesmos que estão no Access.

Podem ser criados na planilha mesmo ou em formulário, fica a gosto. No exemplo aqui eu misturei as duas coisas, coloquei objetos do formulário na planilha.

 

 

Quinto Passo: Criando a comunicação com o Access

 

Aqui eu criei um módulo chamado mod_bd e dentro dele coloquei os códigos abaixo:

 

Sexto Passo: Insert no Access

 

Neste passo foi criado um outro módulo cujo código segue abaixo:

 

Sétimo Passo: Botão Inserir

 

Agora só falta fazer o botão que irá executar:

 

Vídeo Demonstrativo

 

 

 

 

 

Detalhando Formularios Vba 2

          Neste artigo sobre Fomularios VBA você encontrará:

Abrir e Fechar formulário
Limpando todos os campos do formulário
Como colocar barra de rolagem
Imprimir formulário

No artigo Formularios Vba 1 coloquei como alterar o tamanho do formulário, como tirar o botão fechar e como inserir gráficos no formulário. Neste post quero finalizar o assunto e eliminar as principais dúvidas referentes a formulários.

 

Abrir e Fechar Formulário VBA

 

Para abrir formulários vou colocar aqui duas opções: abrir com um botão ou diretamente ao abrir a planilha.

Vou começar com o mais simples, para fechar um formulário bastar colocar: unload Nome_formulário

Para abrir basta colocar o “Nome_Formulario”.Show, abaixo segue imagem onde fica o nome do formulário.

Então agora que sabe como abrir formulário cabe decidir se deseja colocar em um botão na planilha ou abrir direto, para colocar em um botão é só inserir o código de abrir em um módulo e relacionar com o botão.

Para abrir o formulario direto, basta colocar o código conforme a imagem abaixo:

 

Segue vídeo para exemplificar:

 

 

 

 

Limpando Todos Os Campos Do Formulário

 

Abaixo segue código para limpar todos os campos textbox, combobox e radiobox. Devo alertar para os nomes dos controles, pois o código irá varrer no formulário todos os campos e conforme o nome que você colocou irá limpar.

 

 

Resumindo o codigo… Se tiver algum campo no formulario que inicie com text ou txt irá limpar, mesma coisa para os optionButton e combobox.

 

Como Colocar Barra De Rolagem

 

O código é bem simples basta clicar duas vezes no formulário e copiar e colar o código abaixo.

 

Private Sub UserForm_Initialize()

Me.ScrollBars = fmScrollBarsVertical
Me.ScrollHeight = Me.InsideHeight * 2

End Sub

 

Imprimir Formulario

 

Para imprimir o formulário atual coloque o código:

‘Me.PrintForm

 

Se deseja imprimir outro formulário, então coloque:

nomeFormulario.PrintForm

 

 

Detalhando Formularios Vba 1

 

 

Neste artigo sobre Fomularios VBA você encontrará:

• • • • • • • • • Ocultar botão fechar formulario VBA
                • Vba verificar formulário aberto
                • Formulário tela inteira vba excel
                • Inserir gráfico em formulário vba
                • Botão minimizar formulário vba
                • Maximizar formulário vba excel

 

Eu já estava com a ideia de fazer alguns artigos sobre formulários vba, pois ainda não coloquei nenhum artigo a respeito (sobre componentes já foi dito sobre listbox, inputbox e etc).  Coincidência ou não conforme as últimas (e ótimas) conversas que obtive graças a este site o tema era justamente este.

Formulários VBA é um tema muito abrangente, então neste primeiro artigo sobre formulário vamos detalhar sobre algumas dúvidas mais frequentes que percebo e que o pessoal entra em contato como sugestões.

E por último é preciso informar que todos os códigos vba foram testados no Excel 2013! É muito provável que funcione nas versões do Excel 2007 e 2010, entretanto não posso dizer o mesmo para a versão 2003. E os vídeos aqui no artigo fazem referencia a dois tópicos, ou seja há 3 vídeos e cada vídeo retrata sobre 2 assuntos.

 

Ocultar Botão Fechar Formulário VBA

 

Na verdade vou descrever duas opções para esta dúvida, a primeira (código logo abaixo) desativa toda barra de títulos, ou seja não exibe opção de fechar e nem de mover o formulário. É excelente opção se combinado com “formulário tela inteira vba”

A segunda opção (código logo depois da primeira opção) exibe o botão fechar entretanto ele fica inativo forçando ao cliente fechar o formulário cm o botão que você criar.

 

 

1ª Opção – Formulário ocultar barra de títulos

'Insira este código na inicialização do formulário.
Call removeCaption(Me)

_____________________________________________

'Crie um módulo e copie o código abaixo
Private Declare Function FindWindow Lib "User32" _

Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function GetWindowLong Lib "User32" _
Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong Lib "User32" _
Alias "SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Declare Function DrawMenuBar Lib "User32" ( _
ByVal hwnd As Long) As Long

Sub removeCaption(objForm As Object)
Dim lStyle          As Long
Dim hMenu           As Long
Dim mhWndForm       As Long

If Val(Application.Version) < 9 Then
   mhWndForm = FindWindow("ThunderXFrame", objForm.Caption) 'XL97
Else
   mhWndForm = FindWindow("ThunderDFrame", objForm.Caption) 'XL2000+
End If

lStyle = GetWindowLong(mhWndForm, -16)
lStyle = lStyle And Not &amp;HC00000
SetWindowLong mhWndForm, -16, lStyle
DrawMenuBar mhWndForm
End Sub

Código Fonte: http://www.vbaexpress.com

2ª Opção – Desativar Botão Fechar

Para funcionar basta copiar e colar no seu formulário

 

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If CloseMode = 0 Then
   Cancel = True
   MsgBox "Use o botão fechar no rodapé"
End If

End Sub

 

 Vba Verificar Formulário Aberto

 

O código é bem simples, ele verifica entre os vários formulários abertos entre todos que você tem. No caso abaixo eu coloquei mensagem caso ache aberto, mas você pode fechar e etc.

Segue código exclusivo ExceleVba, você somente acha aqui!!

 

 

 

Sub VerificaFormularioAberto()
Dim Forms As Object
For Each Forms In VBA.UserForms
   If Forms.Visible = True Then
      'Aqui fica por sua criatividade/ vontade
      MsgBox Forms.Name & " está aberto"
   End If
Next
End Sub

 

Formulário Tela Inteira VBA Excel

 

 

Aqui vou exibir 2 opções, para funcionar basta colocar na inicialização do formulário. Aqui é bom testar a opção A, opção B ou misturar as duas opções.

Existe outros métodos pela internet entretanto este é o melhor seguindo parâmetro complexidade/funcionalidade.

 

 

‘Opção A

With Me
   .Width = Application.Width
   .Height = Application.Height
End With

‘Opção B

With Me
    .Width = Application.UsableWidth
    .Height = Application.UsableHeight
End With

 

Código Fonte: http://www.ozgrid.com

 

 Inserir Gráfico Em Formulário VBA

 

Como o controle de imagens do formulário busca por imagens em seu computador, o código abaixo pega o gráfico informado cria um gif no local da planilha e exibe a imagem.

 

 

 

 

Private Sub UserForm_Initialize()

'"Plan2" é o nome da guia e "Gráfico 2" é o nome do Gráfico
Set GraficoAtual = Sheets("Plan2").ChartObjects("Gráfico 2").Chart
localNome = ThisWorkbook.Path & "\temp.gif"
GraficoAtual.Export Filename:= localNome, FilterName:="GIF"

Image1.Picture = LoadPicture(localNome)

End Sub

 

Maximizar Formulário Vba Excel

Botão Minimizar Formulário Vba

 

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Const WS_MINIMIZEBOX As Long = & H20000
Private Const WS_MAXIMIZEBOX As Long = & H10000
Private Const GWL_STYLE As Long = (-16)

Private Sub UserForm_Initialize()

Dim lngMyHandle As Long, lngCurrentStyle As Long, lngNewStyle As Long
If Application.Version < 9 Then
   lngMyHandle = FindWindow("THUNDERXFRAME", Me.Caption)
Else
   lngMyHandle = FindWindow("THUNDERDFRAME", Me.Caption)
End If

lngCurrentStyle = GetWindowLong(lngMyHandle, GWL_STYLE)
lngNewStyle = lngCurrentStyle Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
SetWindowLong lngMyHandle, GWL_STYLE, lngNewStyle

End Sub

 

Código Fornecido Por Vagner Beraldo em contato ExceleVBA

__________________________________________

 É isso pessoal em breve estarei fazendo Detalhando Formulários 2!

 

 

 

Como usar figuras com Excel e VBA

Existe várias formas de se lidar com o vba.
Algumas empresas preferem trabalhar o vba em cima da planilha mesmo, outras gostam de trabalhar com vba + fórmulas do excel , um terceiro tipo com Access e excel e um quarto tipo somente com formulários.
Digo isso baseado em experiências e contatos gratificantes que tive através deste site.

 

 

 Usar Figuras com Excel e VBA

Baseado nisso, cada “tipo” possui suas vantagens e desvantagens, contudo hoje quero falar de um assunto que quem trabalha com a planilha obtém vantagem.
No aspecto design e o uso do shapes (figuras) a criatividade é imbatível com as planilhas.

 

Inserir Nome Para As Figuras

Para podermos selecionarmos uma figura, primeiro precisamos definir um nome para elas.

 

Selecionar,  Ocultar e Copiar Figuras com VBA

A partir do nome da figura, podemos selecionar, ocultar e mover as figuras.
Detalhe, aqui estou sando ActiveSheet (ou seja planilhas na Guia Ativa)

'Selecionar figura
ActiveSheet.Shapes.("rostoFeliz1").Select

'Ocultar figuras: false ou true
ActiveSheet.Shapes.("rostoFeliz1").Visible = false

'Copiar figura e já definir destino
ActiveSheet.Shapes("rostoFeliz1").Copy
Sheets("Plan2").Paste

Se eu tivesse acabando de ler isso minha cabeça já está a mil por hora, pois e já iria imaginar…

• Logotipos em planilhas aparecendo na hora de impressão
• Planilhas de qualidade exibindo smiles de sorriso ou tristeza
• Ao abrir uma planilha fazer uma animação de abertura
• Formulários em shapes aparecendo conforme checkbox marcados

Animar Figuras com VBA

Vamos continuar… Irei pegar a idéia de animar figuras com Vba e mostrar como fazer.

 

Sub teste()
mov_figura = 0

Do While mov_figura <= 350

   DoEvents
   mov_figura = mov_figura + 1

   'irá pra a direita
   Plan1.Shapes("rostoFeliz1").Left = mov_figura

   'neste caso coloquei a altura fixa
   Plan1.Shapes("rostoFeliz1").Top = 20

   'aumenta o tamanho da altura da figura
   Plan1.Shapes("rostoFeliz1").Height = mov_figura

   'aumenta a largura
   Plan1.Shapes("rostoFeliz1").Width = mov_figura

   'gira a figura
   Plan1.Shapes("rostoFeliz1").Rotation = mov_figura

Loop
End Sub

 

Observação

Nesse artigo eu usei uma “forma” do Excel, entretanto poderia ter usado uma figura qualquer, basta inserir a figura e seguir os passos descritos nesse artigo

 

Sucesso a todos!

 

VBA com SMTP

 

VBA com SMTP

Alguns anos atrás tive que desenvolver uma rotina, dentro de uma ferramenta VBA, e era obrigatório usar VBA com SMTP para envio de e-mails. Lembro que passei algumas horas para então conseguir meus primeiros testes.

Apesar de já ter colocado um artigo sobre vários tipos de envio de e-mail, segue aqui uma maneira simples de fazer usando SMTP. Com apenas algumas linhas consegui enviar um e-mail e foi muito rápido.

O uso do SMTP é muito útil quando não quer usar o envio de e-mail através do outlook.

Eu também coloco aqui um link com endereços de SMTP e POP dos principais fornecedores de e-mail: ver site.

 

Primeiro Passo

Eu usei um programa que EASendmail que permite envio de e-mail SMTP usando uma licença teste.

 

Segundo Passo

Adicione a referência do vba: “EASendMailObj ActiveX Object”
Na tela de desenvolvimento vá no menu Ferramentas > Referências > e marque EASendMailObj ActiveX Object

 

Terceiro Passo – VBA com SMTP

Sub Btn_EnvioEmailSmtp()
'Atenção: É necessário usar a biblioteca EASendMailObjLib.Mail

Dim oSmtp As New EASendMailObjLib.Mail

'É necessário utilizar essa linha, é a licença de uso
oSmtp.LicenseCode = "TryIt"

'Defina qual endereço do remetente
oSmtp.FromAddr = "brsobral@excelevba.com.br"

'Adicione endereço de email para qual deseja enviar
oSmtp.AddRecipientEx "atendimento@excelevba.com.br", 0

'Assunto do email
oSmtp.Subject = "Envio de simples email por SMTP"

'Mensagem do corpo de Email
oSmtp.BodyText = "Este e-mail foi enviado por VB - teste do site excelevba.com.br"

'Seu endereço SMTP server
'No caso aqui estou usando do gmail
oSmtp.ServerAddr = "smtp.gmail.com"

'Caso necessite usar autenticação SMTP use o código abaixo, caso contrário remova as linhas abaixo
oSmtp.UserName = "xxxxxxxx@gmail.com"
oSmtp.Password = "xxxxxxxx"

' If your smtp server requires SSL connection, please add this line
oSmtp.SSL_init
oSmtp.ServerPort = "587"

MsgBox "Confirme para enviar email ..."

If oSmtp.SendMail() = 0 Then
   MsgBox "Email foi enviado com sucesso!"
Else
   MsgBox "Erro de envio de email com o seguinte código:" & oSmtp.GetLastErrDescription()
End If

End Sub

 

Vídeo Demonstrativo

 

 

 

 

 

Vba Internet : listbox, radiobox, button…

Nesse sobre VBA Internet post você encontrará:

• VBA e Checkbox: marcar e verificar qual está marcado
• VBA e Radiobox: marcar e verificar qual está marcado
• VBA e ListBox: marcar e verificar qual está marcado
• Como clicar em um botão de um site através de VBA
• Clicar em um link através de VBA

 

Este será o último post sobre vba e internet, anteriormente escrevi como fazer login em uma página web e como abrir um site no browser padrão do computador 

Apesar de estar separado em tópicos (acima) vocês perceberão que no código estão tudo em mesmo contexto.
Se quiserem testar basta abrir um módulo e copiar o código abaixo (atenção para as aspas duplas que ao copiar vira apostrofo).

E para ajudar eu criei uma página na internet justamente para facilitar o estudo do código vba. E no rodapé segue vídeo.

 

Muito importante:
Para o código funcionar é necessário marcar a refêrencia: Microsoft Internet Controls
Outra observação é que deve ser verificado no site o Name dos listbox, checkbox e etc

 

vba internet

______________________________________________________________ 

Sub VbaInternet()

Set Internet = New InternetExplorer
Internet.Navigate "http://excelevba.com.br/download/teste_vba.htm"
Internet.Visible = True

While Internet.Busy
DoEvents
Wend

'-------------------------------------------------listbox
'abaixo marca qual linha do listbox queremos que fique marcada
Internet.Document.All.Item("lst_excelevba").selectedindex = 2
nomeVar = Internet.Document.All.Item("lst_excelevba").Item(1).Text

'abaixo verifica qual linha do listbox está marcada
For Each valorLinha In Internet.Document.All.Item("lst_excelevba")
If valorLinha.Selected = True Then
MsgBox "linha marcada = " & valorLinha.Value
End If
Next valorLinha

'-------------------------------------------------------checkbox
'abaixo eu marco um checkbox no site
Internet.Document.All.Item("chk_excelevba").Item(0).Checked = "true"
nomeVar = Internet.Document.All.Item("chk_excelevba").Item(1).Value

'aqui verifico qual checkbox está marcado no site
For Each checkMarcado In Internet.Document.All.Item("chk_excelevba")
If checkMarcado.Checked = True Then
MsgBox "check marcado é o " & checkMarcado.Value
End If
Next checkMarcado

'-----------------------------------------------------radiobox
'abaixo marca uma opção do radiobox
Internet.Document.All.Item("rdo_excelevba").Item(1).Checked = True

'aqui verifica qual radiobox esta marcado
Count = 0
For Each radioMarcado In Internet.Document.All.Item("rdo_excelevba")
If radioMarcado.Checked = True Then
MsgBox "radio marcado é o " & Count
End If
Count = Count + 1
Next radioMarcado

'-------------------------------------------------------textbox
'o comando abaixo escreve na caixa do textbox
Internet.Document.getElementsByName("txt_excelevba").Item.Value = "Bem vindo ExceleVba.com.br"

'---------------------------------------------------------botao
'aqui somente clica no evento do botão no site
Internet.Document.getElementsByName("btn_excelevba").Item.Click

'---------------------------------------------------------link
'e abaixo verifica entre todos os links qual o desejado e clica
For Each link In Internet.Document.Links
If link.href = "http://excelevba.com.br/" Then link.Click
Next link
End Sub

 

Segue vídeo demonstrativo: