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

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

 

Formulário com Filtro de Palavras

 

Hoje quero mostrar um código simples, mas de muita utilidade que irá acrescentar muito em sua planilha: um filtro de palavras.

Já utilizei diversas vezes (acrescentando filtros e aumentando as opções), mas a ideia é mostrar a estrutura do código e deixar conforme a criatividade de cada um.

Encontrei este código no TomasVasquez e alterei para ficar mais simples o entendimento, espero que vocês gostem.

 

Código de funcionamento

 

Private textoDigitado As String

Private Sub TextBox1_Change()
TextoDigitado = TextBox1.Text
Call PreencheLista
End Sub

Private Sub UserForm_Initialize()
'Ao iniciar o formulario ira chamar o procedimento PreencheLista
Call PreencheLista
End Sub

Private Sub PreencheLista()
TextoDigitado = TextBox1.Text
'código que irá filtrar os nomes
Dim linha As Integer
Dim TextoCelula As String
linha = 1
'limpa os dados do formulário
ListBox1.Clear
'Irá executar até o último nome
While ActiveSheet.Cells(linha, 1).Value <> Empty
'pega o nome atual
TextoCelula = ActiveSheet.Cells(linha, 1).Value
'quebra a palavra atual pela esquerda conforme a quantidade de letras digitadas e compara com o texto digitado
If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
'se a comparação for igual será adicionado no formulario
ListBox1.AddItem ActiveSheet.Cells(linha, 1)
End If
linha = linha + 1
Wend
End Sub

 

Código de funcionamento – Opção 2

(Sugestão de Ricardo Marques)

Com esta alteração de código a pesquisa não ficará limitada somente a esquerda do texto, sendo possível pesquisar a partir de toda palavra.

Para isso substitua a linha do código acima:  

“If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then”

Por

If InStr(UCase(textocelula), UCase(textodigitado)) > 0 Then

 

Vídeo Demonstrativo

Arquivo Exemplo

 

Baixar arquivo exemplo: Filtrando Palavras no Listbox

Obs.: Acessando o site do Tomas Vasquez é possível encontrar o filtro de texto aprimorado com mais colunas e etc.
Não coloquei no artigo, pois a idéia é trazer algo mais simplificado!!

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!

 

 

 

ListBox Detalhes 2

 

Neste post você verá:

>> Como preencher um listbox usando VBA
>> Como ordenar um listbox
>> Como remover um item no listbox
>> Como limpar um listbox
>> Como enviar dados do listbox para o excel

 

Esse post , listbox detalhes 2, é a segunda continuação sobre o tema listbox e sobre algumas dúvidas que as pessoas tem a respeito do assunto.
Lembrando que você pode acessar o post exemplo de listbox e abaixar uma planilha modelo e retirar algumas dúvidas.

Siga o post abaixo para ver como usar listbox com VBA

.
Observação: Na imagem abaixo você pode ver como colocar borda no listbox

Observação2: Em ColumnWidths você pode alterar a largura das colunas, exemplo: “50 pt;50 pt”

 

___________________________________________________

>> Como Preencher Um ListBox com VBA

Um detalhe sobre o código abaixo é que mostra como inserir textos em 2 colunas do listbox.
Ou seja .List(0,0)=”teste” significa que na primeira linha e primeira coluna terá o valor “teste”
Caso queira ver mais detalhes e um exemplo prático assista ao vídeo

With Me.listBox1
   .AddItem
   .List(0, 0) = "teste"
   .List(0, 1) = "teste1"
End With

_________________________________________________

Como Ordenar Um Listbox Com VBA

Tentei deixar o código abaixo o quanto mais fácil para entender, você pode ver no vídeo o seu funcionamento.

Sub Ordenar_listbox

itemFinal = listBox1.ListCount - 1

'verifica linha a linha todos os itens
For itemAtual = 0 To itemFinal - 1

'pra cada item do listbox, será verificado todos os itens novamente
For itemPosterior = itemAtual + 1 To itemFinal

'verifica se o item atual verificado é maior que seu sucessor
If listBox1.List(itemAtual) > listBox1.List(itemPosterior) Then

'passa o valor do listbox para uma variavel e assim trocar os valores do listbox
temporario = listBox1.List(itemPosterior)
listBox1.List(itemPosterior) = listBox1.List(itemAtual)
listBox1.List(itemAtual) = temporario
End If
Next itemPosterior
Next itemAtual

End sub

 

_________________________________________________

Como Remover Um Item No ListBox

Para fazer a remoção de uma linha(item) no listbox, temos que pegar qual linha está selecionada e usar o RemoveIt

listBox1.RemoveItem (listBox1.ListIndex)

_________________________________________________

Como Limpar Um ListBox

Bem o comando é bem simples:

listBox1.Clear

_________________________________________________

Como Enviar Dados do Listbox Para O Excel

No exemplo abaixo estou enviando todos os itens do listbox para o Excel
Como no vídeo abaixo o nosso exemplo de listbox possui quatro colunas, estou usando: (i, 0) a (i, 3)
Inicio verificando a ultima linha usada no excel e passo todas as linhas e colunas do listbox

Sub EnviarExcel

qtdeItens = listBox1.ListCount

ultimaLInha = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For i = 0 To qtdeItens - 1
   Sheets(1).Cells(ultimaLInha + 1, 1).Value = listBox1.List(i, 0)
   Sheets(1).Cells(ultimaLInha + 1, 2).Value = listBox1.List(i, 1)
   Sheets(1).Cells(ultimaLInha + 1, 3).Value = listBox1.List(i, 2)
   Sheets(1).Cells(ultimaLInha + 1, 4).Value = listBox1.List(i, 3)

   ultimaLInha = ultimaLInha + 1
Next

End Sub

_______________________________________________

Segue vídeo demostrativo

 

 

Listbox no Vba – Detalhes 1

 

>> Como inserir cabeçalho com listbox no vba
>> Como inserir colunas no listbox
>> Como ver a quantidade de itens no listbox
>> Como saber a linha selecionada no listbox

 

Apesar de já ter um post sobre listbox no vba com exemplo vou detalhar mais sobre o assunto, pois creio que talvez não fique claro e pretendo detalhar mais sobre listbox sendo que este post esta será a primeira parte.
Na imagem abaixo demonstro onde alterar os parâmetros necessários do listbox para poder inserir o cabeçalho, o número de colunas e o preenchimento.

Mais abaixo coloco o vídeo para detalhar …

 

 

COMO INSERIR CABEÇALHO NO LISTBOX
Após inserir o componente de listbox deve-se clicar em cima do componente do listbox e alterar o parâmetro ColumnHeads para True. Você irá perceber que no momento da alteração o listbox irá exibir o contorno do cabeçalho.

Outro detalhe que deve ser visto é o preenchimento dos dados do listbox, conforme na imagem no rowsource eu coloquei os dados sem o cabeçalho.

_____________________________________________________

COMO INSERIR COLUNAS NO LISTBOX
Deve-se clicar em cima do componente do listbox e no parametro ColumnCount inserir o número de colunas necessárias.

_____________________________________________________

COMO VER A QUANTIDADE DE ITENS NO LISTBOX
Para ver a quantidade de itens basta inserir o comando: “nome do listbox”.”ListCount”

Exemplo:
numItens = ListBox1.ListCount

____________________________________________________

COMO SABER A LINHA SELECIONADA NO LISTBOX
Para ver a linha selecionada basta usar o comando:: “nome do listbox”.”ListIndex”

Exemplo:
linhaSelecionada  = ListBox1.ListIndex

 

__________________________________________

Segue vídeo demonstrativo

 

Para ajudar ainda mais segue modelo para download gratuitamente.

Exemplo: Preenchendo – ListBox Vba

 

Preenchendo listbox com rowsource

Coloco abaixo duas maneiras, uma delas demonstro como fazer o preenchimento através do próprio vba e a outra maneira através da propriedade do listbox vba no formulário.

Modo 1 – pelo VBA:

Sei que existe várias maneiras de preencher um listbox, mas coloco aqui um código que gostei pela forma simples e idéias agregadas que achei em pesquisas.

Abaixo segue link para download da planilha com código

Modo 2 – pela propriedade:

Agora se você não gosta de programação vba e deseja um preenchimento mais dinâmico do listbox, aconselho então à adicionar a propriedade no próprio listbox do formulário:

 

Até a próxima

 

Segue ajudar ainda mais segue link para duas planilhas de listbox que estão compactadas:

Download Exemplo Preenchendo Listbox Vba

Como Usar Inputbox no Excel Vba

Aqui neste artigo vou responder como usar inputbox e pra que serve?

Certas situações exige que a gente pergunte algo ao cliente e precisamos saber a resposta para continuar. Por exemplo e se você precisa perguntar a idade do seu cliente? E a resposta depende para filtrar a informação que irá prosseguir…

Então uma das respostas para essa hipotética situação seria o inputbox.

 

 

Codigo como usar Inputbox

 

Sub formasInput()

Dim varTexto As String, varNum As double

' Nessa forma temos INPUTBOX como função :
varTexto = InputBox("Insira um texto", "Aceita qualquer caracter")

' Aqui temos INPUTBOX como metodo :
varNum = Application.InputBox("Insira um número", "Aceita somente números", 1)

MsgBox "Você inseriu :" & Chr(13) & _
varTexto & Chr(13) & varNum, , "Resultado dos InputBox"

End Sub