DESCONTOS DE PORCENTAGENS

DESCONTO SIMPLES

Visitem meu novo blog:

https://programacaopassoapasso.wordpress.com/

Olá galera, depois de muito tempo ausente no blog, vou postar mais umas coisinhas básicas... 

Hoje falarei sobre desconto em % de forma simples direto no Excel mesmo....

Bom para o exemplo que ensinarei vou usar os seguintes campos de exemplo:

Sendo :

Na célula "A2" onde digitaremos um valor qualquer para servir de base. (formate a célula como moeda)

Na célula "B2" vamos digitar o desconto ( a célula deve ser formatada como Percentual)

Na célula "C2" vamos colocar um fórmula para gerar o valor do desconto.(formate a célula como  moeda)

E por fim na célula "D2" vamos colocar outra fórmula para gerar o valor total liquido.(formate a célula como moeda)

Bora lá então!!!!!

Vamos fazer um teste com 100 reais e com 5 % de desconto:

Na célula "C2" vamos colocar a fórmula que vai extrair o valor do desconto de 5 por cento sobre 100 reais... é muito simples basta inserir na célula a seguinte fórmula

=A2*B2

VEJAM:

E O RESULTADO DEVERÁ SER 5...

Agora vamos ver quanto seria 100 subtraindo os 5 reais (DESCONTO)

É simples também, basta digitar "=" e clicar na célula onde esta o valor total ("B2") em seguida digitar a operação que nesse caso será subtração.  (-) e em seguida clicar na célula onde tem o valor do desconto (C2") vejam:

e pronto o resultado será 95, agora basta trocar os valores total e desconto para ter diversos resultados, espero que possa servir para alguém usar em alguma necessidade....

Valeu até a próxima...

DÚVIDAS

GALERA VENHO INFORMAR QUE POR UM TEMPO NAO IREI POSTAR NADA EM MEU BLOG, MAS ESTOU A DISPOSIÇÃO PARA EVENTUAIS DÚVIDAS GERADAS COM AS POSTAGENS JÁ FEITAS....


CASO ALGUÉM TENHA ALGUMA DÚVIDA SOBRE ALGUMA POSTAGEM MINHA, PEÇO QUE AGILIZEM MEU TRABALHO, MANDEM E-MAIL PARA edivan.cabral@yahoo.com.br  E MANDEM A PLANILHA QUE VOCÊS FIZERAM PARA EU DEPURAR, POIS O ERRO GERADO PODE SER DA MINHA PARTE ASSIM COMO DA PARTE DOS LEITORES....



ABRAÇOS A TODOS E BOM APRENDIZADO....

VLW

FAZER A IMAGEM BRILHAR QUANDO PASSAR O MOUSE

MUDAR ASPECTO DA IMAGEM AO PASSAR O MOUSE.

Visitem meu novo blog:

https://programacaopassoapasso.wordpress.com/

A ideia é imitar sabe aqueles programas mais sofisticados que você passa o mouse sobre os objetos e eles mudam de cor, brilho,  sombra e vários outros efeitos legais. Isso nada mais é do que, truques kkkk

Bem para fazer a imagem mudar vamos ter que usar 2 imagens uma que irá aparecer sempre, e a outra que vai aparecer só quando o mouse estiver sobre ela....

Então para ensinar isso aqui vou usar as seguintes imagens:

Notem que a primeira esta sem brilho, já a segunda está um pouco elaborada... assim sendo vamos inserir as duas imagens e tentar colocar o mais próximo possível, uma encima da outra. 

Para isso vamos inserir 2 objetos image, e na propriedade Picture de cada um deles vamos colocar as 2 imagens sendo uma para cada objeto, em seguida colocamos um image encima do outro:

Só para ficar mais fácil de compreender, no objeto image1 eu coloquei a imagem sem brilho e no objeto image2 eu coloquei a imagem sem o brilho.

Para o objeto image2, vamos alterar a propriedade Visible para False, assim só será exibida a image1.

Agora para que ao mover o mouse sobre o image1, o image2 seja exibido vamos usar o seguinte código.Quse será executado quando o mouse se mover sobre o objeto image1.

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

End Sub

Agora dentro desse código vamos exibir a image2 e ocultar e image1.

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Me.Image2.Visible = True

Me.Image1.Visible = False

End Sub

Pronto agora , basta executar e ver se esta funcionando...

Para reverter a situação ou seja quando o mouse sair da imagem, teremos que fazer o mesmo código só que no evento mousemove do userform, e trocando as ações, ocultando a image2 e exibido novamente a image1.

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Me.Image2.Visible = False

Me.Image1.Visible = True

End Sub

Basta executar e mover o mouse sobre a imagem e depois retirar kkkk

COLOCAR LEGENDA EM OBJETOS,COMO TEXTBOX, COMBOBOX, BOTÕES ENTRE OUTROS

LEGENDA EM OBJETOS

Olá, galera vou falar hoje de uma propriedade bem legal que tem em vários objetos no Excel VBA, a propriedade ControlTipText.

Essa propriedade serve para orientar o usuário, tipo sempre que o mouse repousar por alguns instantes sobre o objeto ela será ativada veja o exemplo abaixo.

Isso aí, vlw e até mais...

O CÓDIGO VBA QUE MUDOU MEU JEITO DE PROGRAMAR

DO UNTIL... LOOP

Esse código eu acho sensacional, pois me permite uma série de coisas, agora vou ensinar como ele funciona. É o seguinte, serve para repetir uma serie de códigos quantas vezes você determinar.

Vamos fazer nesse exemplo, uma serie com 5 repetições, sendo que você pode determinar quantas vezes quer a repetição, ou pode colocar de forma automática, exemplo fazer até que tal célula seja vazia, assim o código vai ir até quando a condição for falsa. 

O objetivo é digitar um nome em um textbox e exibir uma mensagem dizendo em qual linha o nome está, caso o nome digitado nao esteja na tabela então a mensagem dirá "NOME NAO ENCONTRADO" vejam:

Bom para o exemplo criei o seguinte userform....

criei a seguinte tabela na plan1.

Agora vou criar um código dentro do evento click do botão botao_verificar

Private Sub BOTAO_VERIFICAR_Click()

End Sub

Em seguida devemos criar uma variável de tipo inteiro e atribuir um valor inicial a mesma. Geralmente o valor inicial é igual ao numero da primeira linha a ser verificada pelo laço de repetição Do Until... Loop.


Private Sub BOTAO_VERIFICAR_Click()

Dim linha As Integer
linha = 2

End Sub

Depois vamos criar o laço de repetição, sendo que o mesmo vai ser repetido apenas por 5 vezes assim sendo como a variavel já tem o valor inicial como 2, então o código Do Until...Loop será executado até que a variável tenha o valor igual a 7.


Private Sub BOTAO_VERIFICAR_Click()
Dim linha As Integer
linha = 2
Do Until linha = 7

linha = linha + 1

Loop
End Sub

Pronto agora sabendo que o laço vai se repetir por 5 vezes isso quer dizer que vai passar uma vez em cada linha afinal a tabela tem apenas 5 registros. Vamos por um código IF para verificar se o valor digitado no objeto TextBox de nome TXT_BUSCA corresponde a uma das 5 linhas na plan1 na coluna "A", sendo que o código vai verificar linha por linha....

Private Sub BOTAO_VERIFICAR_Click()

Dim linha As Integer

linha = 2

Do Until linha = 7

If Me.TXT_BUSCA.Text = Plan1.Range("a" & linha).Value Then

Else

linha = linha + 1

End If

Loop

End Sub

Agora caso os nomes sejam iguais em algum momento do laço, eu quero que seja exibida uma mensagem dizendo "O NOME DIGITADO ESTÁ NA LINHA " aí vai aparecer junto o numero do linha. 


Private Sub BOTAO_VERIFICAR_Click()
Dim linha As Integer
linha = 2
Do Until linha = 7
If Me.TXT_BUSCA.Text = Plan1.Range("a" & linha).Value Then
MsgBox "O NOME DIGITADO ESTÁ NA LINHA " & linha
Else

linha = linha + 1
End If

Loop
End Sub

Agora já que o que eu quero foi efetuado eu vou encerrar a rotina.

Private Sub BOTAO_VERIFICAR_Click()

Dim linha As Integer

linha = 2

Do Until linha = 7

If Me.TXT_BUSCA.Text = Plan1.Range("a" & linha).Value Then

MsgBox "O NOME DIGITADO ESTÁ NA LINHA " & linha

Exit Sub

Else

linha = linha + 1

End If

Loop

End Sub

Agora suponhamos que o laço chegue ao fim sem encontrar nenhuma linha com o mesmo nome que foi digitado no objeto textbox, então eu quero exibir uma nova mensagem dizendo "O NOME DIGITADO NÃO ESTA NA TABELA".


Private Sub BOTAO_VERIFICAR_Click()

Dim linha As Integer
linha = 2
Do Until linha = 7
If Me.TXT_BUSCA.Text = Plan1.Range("a" & linha).Value Then
MsgBox "O NOME DIGITADO ESTÁ NA LINHA " & linha
Exit Sub
Else

linha = linha + 1
End If

Loop
MsgBox "O NOME DIGITADO NAO ESTA NA TABELA", vbExclamation

End Sub

Isso aí agora basta executar o userform digitar o nome desejad e clicar no botão... Sendo que a comparação irá diferenciar as letras maiúsculas das minúsculas kkkkk

APOSTILA VBA CONTROLE DE ESTOQUE PASSO A PASSO

CONTROLE ESTOQUE VBA

Visitem meu novo blog:

https://programacaopassoapasso.wordpress.com/

Galera, boa noite a todos, hoje vou fazer ma promoção kkkkkkkkkkk estou desenvolvendo uma apostila onde ensino passo a passo a criação de um controle de estoque, e preciso saber a opinião alheia, assim sendo os três primeiros leitores que comentarem este post dizendo o que estão achando do meu blog, eu vou enviar uma cópia gratuita da apostila (preciso do e-mail de voces enviem para edivan.cabral@yahoo.com.br) , sendo que após o terminarem de fazer o controle de estoque me deem as suas opiniões sobre a apostila se está fácil de aprender ou não  o que esta faltando para que eu possa fechar e divulgar a criação da mesma....

Aguardo voces kkk

Até mais e boa noite!

EXCEL VBA, CARREGAR DADOS POR NOME OU POR CÓDIGO NO MESMO OBJETO.

CARREGAR PRODUTO ATRAVÉS DA DESCRIÇÃO OU O CÓDIGO

Visitem meu novo blog:

https://programacaopassoapasso.wordpress.com/

Olá, galera dessa vez vou ensinar um código que eu uso muito em meus projetos que funciona da seguinte maneira, em um determinado banco de dados eu tenho os códigos dos produtos e a descrição. Então essa macro vai fazer o seguinte: Se você digitar o nome do produto vai aceitar numa boa e se você resolver digitar o código do produto ela vai retornar o nome que corresponde ao código, e o mais interessante é que retorna dentro do mesmo objeto que você digitou o código.... então para ilustrar isso eu criei a seguinte tabela na Plan1.

Em seguida criei um formulário simples contendo apenas um combobox e um botão de comando vejam:

A primeira coisa a se fazer é criar uma rotina de códigos para preencher o combobox1 com os dados contido na coluna B da plan1.

então vamos lá:

O código deve ser feito no evento INITIALIZE do userform assim no ato de sua abertura o combobox será carregado automaticamente.

Dentro da rotina devemos criar uma variável que servirá para fazer uma passagem em toda a tabela, e geralmente eu a chamo de linha...

na segunda linha do código em vermelho informamos qual será o valor inicial da variável,  que deve ser o numero da primeira linha que tem os dados que serão copiados para o combobox.

Private Sub UserForm_Initialize()

Dim linha As Integer

linha = 2

End Sub

Em seguida devemos criar o laço de repetição que é feito com o código Do Until.... Loop. Sendo que para esse exemplo vamos percorrer toda a plan1, na coluna A linha por linha até encontrar a primeira range(célula) vazia.... vejam:

Private Sub UserForm_Initialize()

Dim linha As Integer

linha = 2

Do Until Plan1.Range("A" & linha).Value = ""

linha = linha + 1

Loop

End Sub

Do Until..... manda o código  passar na pan1 na range(célula) da coluna A e na linha que tiver o mesmo numero da variável que na primeira passagem = 2.

linha = linha + 1 manda o código somar 1 ao valor atual da variável  isso faz com que na próxima vez que o Do Until se iniciar a linha será = 3 e assim por diante.

Loop manda o código voltar ao Do Until.... dessa forma esse código vai ficar rodando na tabela até passar por todas as linhas que não forem vazias afinal o critério para o código para é a primeira célula vazia que encontrar então sairá do laço de repetição, já deu para sacar que todas as linhas que tiverem informações tem que estar uma embaixo da outra, não podendo haver células vazias no meio de células preenchidas..

Continuando, vamos colocar o código que adiciona ao objeto combobox os valores da plan1, na range (célula) da coluna B junto com a linha "X".

Private Sub UserForm_initialize()

Dim linha As Integer

linha = 2

Do Until Plan1.Range("A" & linha).Value = ""

Me.ComboBox1.AddItem Plan1.Range("B" & linha).Value

linha = linha + 1

Loop

End Sub

Pronto a linha inserida no código manda que em cada passagem do laço, ele pegar o valor contido na célula da coluna B & numero representado pela variavel linha e em seguida adicionar ao objeto combobox1. Vamos executar o userform e vejamos o resultado.

Pois bem, agora vamos criar o código para puxar o produto pelo código do mesmo, esse código de programação será inserido no evento afterupdate do objeto combobox, ou seja assim que voce digitar o código do produto e dar um enter, ele vai puxar a descrição do produto para o corpo do objeto combobox1.

Como teremos que percorrer toda a tabela em busca do código digitado, vamos usar um laço de repetição novamente, então a primeira coisa a se fazer é criar a variavel e atribuir o valor inicial da mesma.

Private Sub ComboBox1_afterupdate()

Dim linha As Integer

linha = 2

End Sub

Em seguida vamos criar o laço de repetição que pode ser o mesmo usado no código anterior.

Private Sub ComboBox1_afterupdate()

Dim linha As Integer

linha = 2

Do Until Plan1.Range("A" & linha).Value = ""

linha = linha + 1

Loop

End Sub

Em seguida vamos colocar um bloco IF antes do laço de repetição, para verificar se o valor digitado pelo usuário é um  numero, por que se for um texto então não irá executar a busca pelo código e vai encerrar a rotina através do código Exit Sub.

Private Sub ComboBox1_afterupdate()

Dim linha As Integer

linha = 2

If IsNumeric(Me.ComboBox1.Text) = False Then

Exit Sub

Else

End If

Do Until Plan1.Range("A" & linha).Value = ""

linha = linha + 1

Loop

End Sub

Agora vamos colocar código If dentro do laço de repetição para verificar se o valor da célula (A+linha) é igual ao digitado no objeto combobox, se for vai pegar o valor ao lado no caso, coluna (B+linha) e vai colocar na propriedade Text do objeto combobox. Em seguida devemos colocar o código para encerrar a rotina que é o Exit Sub.

Private Sub ComboBox1_afterupdate()

Dim linha As Integer

linha = 2

If IsNumeric(Me.ComboBox1.Text) = False Then

Exit Sub

Else

End If

Do Until Plan1.Range("A" & linha).Value = ""

If Plan1.Range("A" & linha).Value = Me.ComboBox1.Text Then

Me.ComboBox1.Text = Plan1.Range("B" & linha).Value

Exit Sub

Else

End If

linha = linha + 1

Loop

End Sub

Agora para encerrarmos o nosso código, vamos inserir após o código Loop, um código que exibirá uma mensagem avisando ao usuário que o código não foi encontrado, afinal se ele for encontrado então o laço de repetição vai ser encerrado junto com a rotina por meio do código Exit Sub, assim sendo essa mensagem só será exibida caso o laço chegue ao fim, e se isso acontecer é por o código digitado não foi encontrado.

Private Sub ComboBox1_afterupdate()

Dim linha As Integer

linha = 2

If IsNumeric(Me.ComboBox1.Text) = False Then

Exit Sub

Else

End If

Do Until Plan1.Range("A" & linha).Value = ""

If Plan1.Range("A" & linha).Value = Me.ComboBox1.Text Then

Me.ComboBox1.Text = Plan1.Range("B" & linha).Value

Exit Sub

Else

End If

linha = linha + 1

Loop

MsgBox "CÓDIGO NÃO ENCONTRADO", vbCritical

End Sub

Agora basta executar o userform, digitar um código e dar um enter, e ver o resultado...

FÓRMULA QUE SUBSTITUI PROCV

FUNCIONA COMO PROCV

Visitem meu novo blog:

https://programacaopassoapasso.wordpress.com/

Galera vou ensinar hoje uma combinação de fórmulas que eu aprendi com um cara fodasssso mesmo no Yahoo Respostas. Acho que acima do que sabemos está a simplicidade de poder compartilhar com o próximo e ajudar tantas e tantas pessoas que assim como eu estão aí para aprender cada vez mais.

A ideia dessa combinação é fazer exatamente o que o Procv faz porém ela é muito mais interessante, exemplo:

Bom vou explicar o resultado desejado e em seguida a fórmula, o que quero é o seguinte veja a imagem abaixo.

Preciso que ao digitar um determinado nome, na célula que está marcada com um "x" as demais células me retornem os valores que correspondem ao nome digitado.

Vou usar 2 fórmulas (CORRESP e ÍNDICE)

> A fórmula  "corresp"  tem a função de descobrir qual é a posição de um item em relação a uma tabela exemplo: na tabela que teho as informações o meu nome EDIVAN é o primeiro item da lista então o corresp vai retornar "1" pois é o texto procurado esta ocupando a posição 1.

> Na célula ao lado da marcada com o x, na coluna "B" vamos inserir a fórmula corresp.... que ficaria assim:

=CORRESP(

inicio da fórmula....

$A$11  célula que é a referencia, onde será digitado o texto procurado.

$A$2:$A$7   área que tem as informações

pronto como não há informação na célula de referencia o resultado será #N/D a diante vamos corrigir isso, mas por agora vamos digitar um nome que contém na tabela ex:

Veja que o numero retornado foi o 3, sendo que ANA MARIA está na terceira linha do intervalo demarcado na fórmula ($A$2:$A$7)

Pronto agora vamos partir para a fórmula ÍNDICE que tem a função de retornar um determinado valor que está na linha "x" da coluna "x".

Vamos inserir antes de CORRESP a fórmula ÍNDICE pois o numero da linha será o valor gerado pela fórmula CORRESP e a coluna será "1" vamos lá então...

=ÍNDICE(

$B2:$B7  Aqui determinamos qual será a area com os dados a serem retornados.

o corresp está informando ao índice qual é a linha

 no final da fórmula tem ;1) que esta informando qual é o numero da coluna, como temos uma unica coluna no intervalo azul,vamos usar o numero 1.

e o resultado deverá ser este:

Vamos copiar a fórmula e colar para a IDADE e o SEXO.

VEJA: IDADE...

 Reparem que a unica coisa que mudou foi a referencia em azul pois agora a coluna que terá o valor retornado será a coluna "C".

SEXO...

Pronto eu achei essa fórmula mais funcional do que a procv.

Para corrigir o Erro #N/D vamos fazer a seguinte fórmula...

=SE(ÉERROS(FÓRMULA);"";MESMA_FÓRMULA)

Veja pronto como ficaria para a coluna SOBRENOME:

=SE(ÉERROS(ÍNDICE($B2:$B7;CORRESP($A$11;$A$2:$A$7;0);1));"";ÍNDICE($B2:$B7;CORRESP($A$11;$A$2:$A$7;0);1))

Basta repetir nas demais assim, caso seja digitado um nome que nao existe na tabela ou mesmo a célula da busca esteja vazia não vai retornar nada...

Galera espero que tenham compreendido e o mais importante consigam adaptar as próprias necessidades.

vlw até mais

Dúvidas postem comentãrios ou mandem e-mail para mim edivan.cabral@yahoo.com.br

Edivan Cabral

Galera, Dúvidas????

Bom galera desculpem a ausência que eu estou do meu blog, mas é que não estou tendo mais tanto tempo disponível para postar nada kkkkk... mas se acaso alguem precisar de alguma ajuda, desde que não seja gradiosa ou dificil kkkkkkkkkk mande no meu e-mail edivan.cabral@yahoo.com.br na medidado possivel irei vendo e tentando ajudar...


Acontece que estou trabalhando no desenvolvimento de um video curso onde ensinarei a criar passo a passo um controle de estoque em VBA....


At; Edivan Cabral

CARREGANDO DA PLANILHA PARA OS TEXTBOXS....

DO UNTIL PARA CARREGAR INFORMAÇÕES...

A ideia é digitar o código dos produto e o mesmo ser carregado para os TextBox do UserForm...

Para isso criei um pequeno banco de dados... vejam:

O UserForm fiz assim :

Os objetos são Textbox1 para o código, TextBox2 para Produtos e TextBox3 para Valor...

O código que fará a busca vou colocar no evento afterupdate do objeto Textbox1 assim ao digitar o código e teclar enter a busca será realizada...

o código é :

Private Sub TextBox1_afterupdate()

Dim linha As Integer

linha = 2

Do Until Plan1.Range("a" & linha).Value = ""

If Plan1.Range("a" & linha).Value = Me.TextBox1.Text Then

Me.TextBox2.Text = Plan1.Range("b" & linha).Value

Me.TextBox3.Text = Format(Plan1.Range("c" & linha).Value, "CURRENCY")

encontrado = "sim"

Exit Sub

Else

linha = linha + 1

End If

Loop

MsgBox "CÓDIGO NÃO ENCONTRADO", vbCritical

End Sub

E o resultado será :

Caso digite um código inexistente será informado do mesmo através de uma mensagem de aviso....

INSERINDO FÓRMULA EM FORMAS DO EXCEL...

NOVIDADES PARA MIM...

Galera hoje mexendo aqui na net achei uma coisa muito legal e resolvi postar aqui para que mais pessoas possam conhecer e fazer uso de alguma forma... sabe aquelas formas modelos que temos no Excel, balões, círculos  quadrados entre outros...

É só inserir a forma...

 

e ao invés de escrevermos o texto podemos por uma fórmula para pegar o valor de uma célula por exemplo...

Dessa forma tudo o que conter na célula A1 irá aparacer na fórmula, gostei muito dessa ideia dá para abusar na criatividade agora hein..... kkkkkkkkkkk

Bom por hoje é isso galera se alguém conhecer alguma coisa legal tipo essa posta um comentário aqui para eu fazer um post ensinando....

FORMULÁRIO COM BOTÕES MAXIMIZAR E MINIMIZAR

CÓDIGO PARA INSERIR OS BOTÕES MAXIMIZAR E MINIMIZAR.

Visitem meu novo blog:

https://programacaopassoapasso.wordpress.com/

Bom para realizar essa façanha vamos criar um UserForm:

Em seguida criaremos um módulo de classe...

O nome do nosso módulo de classe será "ClasseForm"...


O código abaixo todo ele em azul devemos copiar e colar dentro do ClasseForm.


'Colocar no ClasseForm


Option Explicit

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 GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long

Private Const GWL_STYLE As Long = (-16)
Private Const GWL_EXSTYLE As Long = (-20)
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_SYSMENU As Long = &H80000
Private Const WS_THICKFRAME As Long = &H40000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const WS_POPUP As Long = &H80000000
Private Const WS_VISIBLE As Long = &H10000000

Private Const WS_EX_DLGMODALFRAME As Long = &H1
Private Const WS_EX_APPWINDOW As Long = &H40000
Private Const WS_EX_TOOLWINDOW As Long = &H80

Private Const SC_CLOSE As Long = &HF060

Private Const SW_HIDE As Long = 0
Private Const SW_SHOW As Long = 5

Private Const WM_SETICON = &H80

Dim hWndForm As Long, mbSizeable As Boolean, mbCaption As Boolean, mbIcon As Boolean, miModal As Integer
Dim mbMaximize As Boolean, mbMinimize As Boolean, mbSysMenu As Boolean, mbCloseBtn As Boolean
Dim mbAppWindow As Boolean, mbToolWindow As Boolean, msIconPath As String
Dim moForm As Object
Public Property Let Modal(bModal As Boolean)
    miModal = Abs(CInt(Not bModal))

    'Make the form modal or modeless by enabling/disabling Excel itself
    EnableWindow FindWindow("XLMAIN", Application.Caption), miModal
End Property

Public Property Get Modal() As Boolean
    Modal = (miModal <> 1)
End Property

Public Property Set Form(oForm As Object)

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

    Set moForm = oForm

    AtualizarEstiloForm

    AtualizarIcone
    
End Property

Private Sub AtualizarEstiloForm()

    Dim iStyle As Long, hMenu As Long, hID As Long, iItems As Integer

    If hWndForm = 0 Then Exit Sub

    iStyle = GetWindowLong(hWndForm, GWL_STYLE)

    iStyle = iStyle Or WS_CAPTION
    iStyle = iStyle Or WS_SYSMENU
    iStyle = iStyle Or WS_THICKFRAME
    iStyle = iStyle Or WS_MINIMIZEBOX
    iStyle = iStyle Or WS_MAXIMIZEBOX
    iStyle = iStyle And Not WS_VISIBLE And Not WS_POPUP

    SetWindowLong hWndForm, GWL_STYLE, iStyle

    iStyle = GetWindowLong(hWndForm, GWL_EXSTYLE)

    iStyle = iStyle And Not WS_EX_DLGMODALFRAME
    iStyle = iStyle Or WS_EX_APPWINDOW

    SetWindowLong hWndForm, GWL_EXSTYLE, iStyle

    hMenu = GetSystemMenu(hWndForm, 0)
    
    ShowWindow hWndForm, SW_SHOW
    DrawMenuBar hWndForm
    SetFocus hWndForm

End Sub

Private Sub AtualizarIcone()

    Dim hIcon As Long

    On Error Resume Next
    
    If hWndForm <> 0 Then

    msIconPath = "C:\Meus documentos\EU\FabioNovo.ico"  'Coloque aquí o seu ícone
        Err.Clear
        If msIconPath = "" Then
            hIcon = 0
        ElseIf Dir(msIconPath) = "" Then
            hIcon = 0
        ElseIf Err.Number <> 0 Then
            hIcon = 0
        ElseIf Not mbIcon Then
            hIcon = ExtractIcon(0, msIconPath, 0)
        Else
            hIcon = 0
        End If

        SendMessage hWndForm, WM_SETICON, True, hIcon
    End If

End Sub

O código abaixo devemos copiar e colar dentro do UserForm

Option Explicit

Dim nAtualizaForm As New ClasseForm

Private Sub btnOK_Click()

End

End Sub

Private Sub cbModal_Change()

nAtualizaForm.Modal = cbModal.Value

End Sub

Private Sub UserForm_Activate()

Set nAtualizaForm.Form = Me

'Me.cbModal.Value = False

End Sub

E pronto é só executar e ver o resultado...

Se quisermos  mexer na planilha sem precisar fechar o UserForm devemos alterar o propriedade ShowModal do UserForm para False...


Espero sinceramente que consigam reproduzir a imagem no inicio com o seu próprio UserForm...

Valeu e até breve...

EXCEL VBA MENSAGEM COM OPÇÃO DE ESCOLHA

MSGBOX COM OPÇÃO DE ESCOLHA

Muitas das vezes é necessário que o usuário tome decisões e isso é muito útil para evitarmos por exemplo excluir acidentalmente informações valiosas...

Assim sendo hoje irei ensinar a criar uma pergunta para o usuário e a partir da resposta o código faz isso ou faz aquilo...

Para tal vamos criar uma macro dentro de um módulo...

Sub teste()

    Dim resultado As VbMsgBoxResult

    resultado = MsgBox("Escolha um dos botões SIM ou NÃO ", vbInformation + vbYesNo, "TESTE")

    If resultado = vbYes Then

    MsgBox "VOCÊ ESCOLHEU O BOTÃO SIM"

    Else

    MsgBox "VOCÊ ESCOLHEU O BOTÃO NÃO"

    End If

End Sub

Ao executarmos essa macro a seguinte mensagem é exibida:

Ao escolher nossa opção uma mensagem será exibida dizendo qual a nossa escolha...

Vejam exemplo:

Passo a passo da macro...

Dim resultado As VbMsgBoxResult Aqui criei a variável do tipo caixa de mensagem resultado.

A segunda linha é responsável por criar a caixa de mensagem vejam...

 

If resultado = vbYes Then  se a resposta do usuário for o botão ok (vbyes) fazer

    MsgBox "VOCÊ ESCOLHEU O BOTÃO SIM" outra mensagem com o texto que está entre aspas

    Else  já se a escolha não for o botão sim então fazer

    MsgBox "VOCÊ ESCOLHEU O BOTÃO NÃO" outra mensagem com o texto que está entre aspas

    End If fim do bloco if (se)

Desse modo quando você criar uma rotina de exclusões é só introduzir esse código de modo que se o usuário clicar sim o código faça a exclusão se não... já sabem né kkkkkkk...

Bom galera por hoje é isso... até a próxima....

SOMA EM TEXTBOX

FAZER SOMA EM UM TEXTBOX COM USO DE VBA...

Para tal, vamos criar um UserForm com 2 TextBox e 1 Label...

Agora o código será da seguinte fórmula

1° vamos criar 2 variável uma para cada valor...

na prática:

Dim valor_1 As double 

Dim valor_2 As double 

2° Vamos verificar se o TextBox1 é igual a vazio se for então vamos atribuir "0" como valor para a variável "valor_1", caso não seja vamos atribuir a variável "valor_1" o mesmo valor que conter na TextBox1...

na prática:

If Me.TextBox1.Text = "" then

valor_1 = 0

Else

valor_1 = Me.TextBox1.Text

End if

3° Copiar e colar o código acima e substituir pelo objeto TextBox2 e pela variável "valor_2"...

na prática:

If Me.TextBox2.Text = "" then

valor_2 = 0

Else

valor_2 = Me.TextBox2.Text

End if

4° Agora é só dizer ao código para somar o valor das 2 variáveis e atribuir ao Label1...

na prática:

Me.Label1.Caption = valor_1 + Valor_2

Pronto agora é só chamar esse código dentro dos 2 objetos TextBox1 e 2... no evento AfterUpdate que será executado quando sair do objeto....

Dim valor_1 As double 

Dim valor_2 As double 

If Me.TextBox1.Text = "" then

valor_1 = 0

Else

valor_1 = Me.TextBox1.Text

End if

If Me.TextBox2.Text = "" then

valor_2 = 0

Else

valor_2 = Me.TextBox1.Text

End if

Me.Label1.Caption = valor_1 + Valor_2

Isso aí galera....

Agora ao executar o UserForm é só testar ....

Valeu abraços e até mais...