Textbox em maiúsculo ou minúsculo

Para configurar um textbox permitindo somente a entrada de caracteres maiúsculos ou minúsculos é bastante simples...

Código dentro do procedimento Change da textbox1 que converte o texto para maiúsculo

Private Sub TextBox1_change()

TextBox1 = UCase(TextBox1)

End Sub



Código dentro do procedimento Change da textbox2 que converte o texto para minúsculo
   
Private Sub TextBox2_Change()

TextBox2 = LCase(TextBox2)

End Sub

Somar horas em Excel com VBA

Nesse Post mostro como fazer a soma no excel com VBA... essa soma pode ser aplicada a formulários e pode ser configurada de diversas maneiras... ideal para controle de banco de horas ou soma de tempo de serviços...

link para download da planilha

https://drive.google.com/file/d/0B2tBlpeZsUSZSExXNExUTHBXaUU/edit?usp=sharing

A função Abaixo deve ser colada dentro de um módulo no editor VBA do excel. O formato será definido via código adicionando-se o comando da função FormatInterval da seguinte maneira:

FormatInterval(sua_variável,"Formato")

Os formatos são listados na figura abaixo:

Para mais detalhes assista o vídeo no início deste post.

Código da Função a ser colada em um módulo:

Function FormatInterval(ByVal Interval As Variant, Fmt As String)
'Formata a diferença entre duas datas ou a soma
'mostraem formato de dia, horas, minutos e segundos.


' Suporta os seguintes formatos:
'   D H                    5 Days 5 Hours
'   D H:MM                 5 Days 5:15
'   D HH:MM                5 Days 05:15
'   D H:MM:SS              5 Days 5:15:45
'   D HH:MM:SS             5 Days 05:15:45
'   H M                    125 Hours 15 Minutes
'   H:MM                   125:15
'   H:MM:SS                125:15:45
'   M S                    7515 Minutes 45 Seconds
'
Dim Days As Long, Hours As Long, Minutes As Long, Seconds As Long
'
' Verifica Date or Double
'
  If VarType(Interval) <> 7 And VarType(Interval) <> 5 Then Exit Function
'
' Analisa os dias
'
  Days = Int(Interval)
  Interval = Interval - Days
  If Interval > #11:59:59 PM# Then
    Days = Days + 1
    Interval = 0#
  End If
'
' Analisa as horas
'
  Interval = Interval * 24
  Hours = Int(Interval)
  Interval = Interval - Hours
  If Interval > 3599# / 3600# Then
    Hours = Hours + 1
    Interval = 0#
  End If
'
' Analisa os minutos
'
  Interval = Interval * 60
  Minutes = Int(Interval)
  Interval = Interval - Minutes
  If Interval > 59# / 60# Then
    Minutes = Minutes + 1
    Interval = 0#
  End If
'
' Analisa os segundos
'
  Seconds = Int(Interval * 60 + 0.5)
'
' Normalize
'
  If Seconds = 60 Then
    Minutes = Minutes + 1
    Seconds = 0
  End If
  If Minutes > 59 Then
    Hours = Hours + 1
    Minutes = Minutes - 60
  End If
  If Hours > 23 Then
    Days = Days + 1
    Hours = Hours - 24
  End If
'
' Criação do Formato
'
  Select Case Fmt
    Case "D H"
      FormatInterval = Days & IIf(Days <> 1, " Dias ", " Dia ") _
          & Hours & IIf(Hours <> 1, " Horas", " Hora")
    Case "D H:MM"
      FormatInterval = Days & IIf(Days <> 1, " Dias ", " Dia ") _
          & Hours & ":" & Format(Minutes, "00")
    Case "D HH:MM"
      FormatInterval = Days & IIf(Days <> 1, " Dias ", " Dia ") _
          & Format(Hours, "00") & ":" & Format(Minutes, "00")
    Case "D H:MM:SS"
      FormatInterval = Days & IIf(Days <> 1, " Dias ", " Dia ") _
          & Hours & ":" & Format(Minutes, "00") & ":" & Format(Seconds, "00")
    Case "D HH:MM:SS"
      FormatInterval = Days & IIf(Days <> 1, " Dias ", " Dia ") _
          & Format(Hours, "00") & ":" & Format(Minutes, "00") & ":" _
          & Format(Seconds, "00")
    Case "H M"
      Hours = Hours + Days * 24
      FormatInterval = Hours & IIf(Hours <> 1, " Horas ", " Hora ") & Minutes _
          & IIf(Minutes <> 1, " Minutos", " Minuto")
    Case "H:MM"
      Hours = Hours + Days * 24
      FormatInterval = Hours & ":" & Format(Minutes, "00")
    Case "H:MM:SS"
      Hours = Hours + Days * 24
      FormatInterval = Hours & ":" & Format(Minutes, "00") & ":" _
          & Format(Seconds, "00")
    Case "M S"
      Minutes = Minutes + (Hours + Days * 24) * 60
      FormatInterval = Minutes & IIf(Minutes <> 1, " Minutos ", " Minuto ") _
          & Seconds & IIf(Seconds <> 1, " Segundos", " Segundo")
    Case Else
      FormatInterval = Null
  End Select
End Function

Somar valores dentro de ListView

O Código abaixo esta inserido Dentro do Procedimento Inicializar (Initiaze) de um Formulário. Ao ser aberto, o Código contido no procedimento Inicializar ira nomear as colunas da listview *, adicionar os dados **, e efetua a soma da coluna valor. ***

Private Sub UserForm_Initialize ()


'* Adiciona as colunas a ListView1
    
           With ListView1
        .Gridlines = True
        .View = lvwReport
        .FullRowSelect = True
        .ColumnHeaders.Add Text:="Mes", Width:=75
        .ColumnHeaders.Add Text:="Quantidade", Width:=60
        .ColumnHeaders.Add Text:="Valor", Width:=50, Alignment:=2
       
       End With

ListView1.ListItems.Clear

'** Adiciona os dados a  ListView1

Sheets("dados").Select
 lin = 2
        
        Do Until Sheets("dados").Cells(lin, 1) = ""
                        
        Set li = ListView1.ListItems.Add(Text:=Sheets("dados").Cells(lin, 1).Value) 'mes
        li.ListSubItems.Add Text:=Sheets("dados").Cells(lin, 2).Value 'quant
        li.ListSubItems.Add Text:=Sheets("dados").Cells(lin, 3).Value 'Coluna a ser somada
                
        
        lin = lin + 1
    
    Loop

'***    Efetua a soma e coloca  o valor na Caixa de texto Chamada txt_soma
       
   Dim soma As Double
     
     For i = 1 To ListView1.ListItems.Count
     soma = soma + ListView1.ListItems.Item(i).SubItems(2)
     Next i
    
     txt_soma = soma

End Sub

Evitar erro no preenchimento de um campo no formato data

Supondo que o nome da TextBox que receberá a data é txt_vencimento temos o seguinte código:

      

- O Procedimento KeyPress formatará o campo para que ao digitar sejam colocada as barras e o campo tenha o tamanho correto... se for adaptar ao seu código não esqueça de trocar todos os nomes de objetos txt_vencimento que aparece no código pelo nome da sua TextBox.

Private Sub txt_vencimento_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

txt_vencimento.MaxLength = 10 '10/10/2014
 Select Case KeyAscii
      Case 8       'Aceita o BACK SPACE
      Case 13: SendKeys "{TAB}"    'Emula o TAB
      Case 48 To 57
        If txt_vencimento.SelStart = 2 Then txt_vencimento.SelText = "/"
         If txt_vencimento.SelStart = 5 Then txt_vencimento.SelText = "/"
      Case Else: KeyAscii = 0     'Ignora os outros caracteres
   End Select

End Sub

- No procedimento AfterUpdate será feito o teste para verificar se o valor do dia esta entre 1 e 31, se o valor do mês esta entre 1 e 12 e também se a data digitada não é menor que a data atual, pois como se trata de um campo de vencimento não podemos ter uma data anterior.

Private Sub txt_vencimento_AfterUpdate()

Dim data As Date
data = Me.txt_vencimento

If Left(Me.txt_vencimento, 2) > 31 Then
   MsgBox "Data preenchida de forma incorreta, dia inválido", vbExclamation, "Erro Data"
   Me.txt_vencimento = ""
ElseIf Right(Left(Me.txt_vencimento, 5), 2) > 12 Then
   MsgBox "Data preenchida de forma incorreta, mês inválido", vbExclamation, "Erro Data"
   Me.txt_vencimento = ""
ElseIf data < Now Then
   MsgBox "A data deve ser maior que hoje, cadastro não permitido", vbExclamation, "Erro Data"
   Me.txt_vencimento = ""
End If
End Sub

* Entendendo o código ( Left e Right)
   Right(Left(Me.txt_vencimento, 5), 2)

 Supondo que tenha sido digitado a data 25/12/2014
 O comando Right irá retornar os 2 caracteres da direita para esquerda que estiver contido dentro dele...
 Como dentro do Right temos um Left... vamos descobrir o que o Left retorna para entender o código.
 Left(Me.txt_vencimento, 5) esta retornando os 5 primeiros caracteres ou valores do conteúdo da caixa de texto txt_vencimento, ou seja 25/12.
Dessa forma o Right estará retornando o valore 12, pois retorna os 2 caracteres da direita para esquerda.

* Entendendo o código ( SelStart e SelText)  If txt_vencimento.SelStart = 2 Then txt_vencimento.SelText = "/"

 Significa que quando digitar o segundo caractere será inserido a /

Máscaras de texto em VBA

Máscaras de texto em VBA

       Os códigos mostrados a seguir são úteis para colocar máscaras de auto-preenchimento em textbox em formulários VBA.

       Para utilizar as seguintes máscaras deve-se somente substituir o nome de cada objeto para o mesmo existente em seu código... o procedimento para que as máscaras funcionem é o KeyPress. Para selecioná-lo basta dar um duplo-click sobre a caixa de texto e selecionar o procedimento,  conforme a figura abaixo...

Figura 01. Selecionando o procedimento KeyPress em um TextBox

• Máscara de texto para data

Private Sub txt_data_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

txt_data.MaxLength = 10 '10/10/2014

 Select Case KeyAscii

      Case 8       'Aceita o BACK SPACE

      Case 13: SendKeys "{TAB}"    'Emula o TAB

      Case 48 To 57

         If txt_data.SelStart = 2 Then txt_data.SelText = "/"

         If txt_data.SelStart = 5 Then txt_data.SelText = "/"

      Case Else: KeyAscii = 0     'Ignora os outros caracteres

   End Select

End Sub

• Máscara de texto para CPF

Private Sub txt_cpf_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

txt_cpf.MaxLength = 14 '032.656.054-71

   Select Case KeyAscii

      Case 8       'Aceita o BACK SPACE

      Case 13: SendKeys "{TAB}"    'Emula o TAB

      Case 48 To 57

         If txt_cpf.SelStart = 3 Then txt_cpf.SelText = "."

         If txt_cpf.SelStart = 7 Then txt_cpf.SelText = "."

         If txt_cpf.SelStart = 11 Then txt_cpf.SelText = "-"

         Case Else: KeyAscii = 0     'Ignora os outros caracteres

   End Select

End Sub

• Máscara de texto para CNPJ

Private Sub txt_cnpj_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
txt_cnpj.MaxLength = 18 '07.454.325/0001-41
   Select Case KeyAscii
      Case 8       'Aceita o BACK SPACE
      Case 13: SendKeys "{TAB}"    'Emula o TAB
      Case 48 To 57
         If txt_cnpj.SelStart = 2 Then txt_cnpj.SelText = "."
         If txt_cnpj.SelStart = 6 Then txt_cnpj.SelText = "."
         If txt_cnpj.SelStart = 10 Then txt_cnpj.SelText = "/"
         If txt_cnpj.SelStart = 15 Then txt_cnpj.SelText = "-"
         Case Else: KeyAscii = 0     'Ignora os outros caracteres
   End Select
 
End Sub

• Máscara de texto para CEP

Private Sub txt_cep_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
txt_cep.MaxLength = 10 '88.888-110
 Select Case KeyAscii
      Case 8       'Aceita o BACK SPACE
      Case 13: SendKeys "{TAB}"    'Emula o TAB
      Case 48 To 57
         If txt_cep.SelStart = 2 Then txt_cep.SelText = "."
         If txt_cep.SelStart = 6 Then txt_cep.SelText = "-"
      Case Else: KeyAscii = 0     'Ignora os outros caracteres
   End Select
End Sub

• Máscara de texto para TELEFONE

txt_fone.MaxLength = 13 '(45)3332-3333

 Select Case KeyAscii

      Case 8       'Aceita o BACK SPACE

      Case 13: SendKeys "{TAB}"    'Emula o TAB

      Case 48 To 57

         If txt_fone.SelStart = 0 Then txt_fone.SelText = "("

         If txt_fone.SelStart = 3 Then txt_fone.SelText = ")"

         If txt_fone.SelStart = 8 Then txt_fone.SelText = "-"

      Case Else: KeyAscii = 0     'Ignora os outros caracteres

   End Select

• Máscara de texto para MOEDA

Private Sub txt_moeda_AfterUpdate()

txt_moeda.Text = Format(txt_moeda.Text, "Currency")

End Sub

Private Sub txt_moeda2_AfterUpdate()

txt_moeda2 = Format(txt_moeda2, "R$ #,##0.00")

End Sub

Arquivo para download:

https://drive.google.com/file/d/0B2tBlpeZsUSZTl90NXVwOVZ3ZEU/edit?usp=sharing

Link para Vídeo sobre máscara de texto:

 http://youtu.be/4sS5gC-pqTA

Att.

Renam

Como ativar o controle Listview no Excel

Como ativar o controle Listview no Excel

Para adicionar a ferramenta Listview, basta dar um clique com o botão direito sobre a caixa de ferramentas, selecionar controles adicionais e marcar a opção conforme Imagem 01. Esse processo pode não ser tão fácil pois acontece em muitas máquinas não conter o Microsoft WindowsCommon Controls 6.0 (SP6), pois ele não é nativo do Office.

Imagem 01. Inserindo o controle Listview.

Nesse caso deve-se buscar o arquivo .OCX que possui essa referência, fazer a instalação (colar o arquivo mscomctl.ocx  dentro da pasta C:\windows\system32). O arquivo pode ser encontrado no site da Microsoft no seguinte link 

http://www.microsoft.com/en-us/download/details.aspx?id=10019

ou

Atualizado dia 25/09/14 - Biblioteca MSCOMCTL.OCX atualizada, versão 6.01.9834

Download via DropBox:

https://www.dropbox.com/s/xn0tkccrig6t6p5/MsComCtl_Ocx_6.01.9834.rar?dl=0

pode ser necessário registrar manualmente a biblioteca para isso

entre no prompt de comando como ADMINISTRADOR e digite

REGSVR32 C:\WINDOWS\System32\MSCOMCTL.OCX

se seu sistema for 64 Bits

REGSVR32 C:\WINDOWS\SysWOW64\MSCOMCTL.OCX

* Lembrando que essa .OCX deve ser copiada para para pasta System32 também, pois em Windows 64 bits essas bibliotecas trabalham em binário e o mesmo arquivo deve estar nas duas pastas, ou seja, System32 e SysWOW64, mas deve ser registrada como administrador em somente uma delas...

* Se o Office for 64Bits não há suporte a essas bibliotecas e os projetos que tiverem esses objetos não funcionarão, mesmo registrando e setanto as referências. Para trabalhar com programação em VBA, utilize somente versões 32Bits do Office.

Imagem 02. Selecionando a Referência  Microsoft WindowsCommon Controls 6.0 (SP6)

Após esse procedimento, entrar no menu ferramentas do VBA ir em Referências e selecionar então o  Microsoft WindowsCommon Controls 6.0 (SP6) (Imagem 07).  Refazer o procedimento da Imagem 01 para adicionar o controle Listview a caixa de ferramentas.

Pode ser necessário fazer o mesmo procedimento com o arquivo MSSTKPRP.DLL, ou seja, salvar na pasta System32 ou SysWOW64 - dependendo do sistema e fazer o registro manual...

entre no prompt de comando como ADMINISTRADOR e digite:

REGSVR32 C:\WINDOWS\System32\MSSTKPRP.DLL

se seu sistema for 64Bits

REGSVR32 C:\WINDOWS\SysWOW64\MSSTKPRP.DLL

link para download do arquivo  MSSTKPRP.DLL:

https://www.dropbox.com/s/8cx818hkiepgg3v/MSSTKPRP.DLL?dl=0

Inserindo Calendário POP UP em Formulário.

Inserindo Calendário POP UP em Formulário.

Esse Post mostra como inserir um botão que abre um calendário onde é possível selecionar a data desejada. A seleção mostrará a data selecionada na Textbox relacionada...

01. Calendário aberto para selecão da Data

O funcionamento desse calendário depende da importação de alguns arquivos que estão no link abaixo.

Os arquivos são:

- frmCalendário.frm

- mdlCalendário.bas

- Módulo11.bas

- cCalendário.cls

Link para os arquivos: Compartilhado via Google Drive

https://drive.google.com/file/d/0B2tBlpeZsUSZaXdWTXFMaXBBLVE/edit?usp=sharing

A importação dos aquivos será feita para pasta suas respectivas pastas, ou seja:

Para pasta  Formulários: Arquivo  frmCalendário.frm

Para a pasta módulo serão importados 2 arquivos: mdlCalendário.bas e Módulo11.bas

E no Módulo de Classe 1 arquivo: cCalendário.cls

A importação segue os passos da imagem 02. A seguir

02. importação dos Arquivos

Após importar cada arquivo para sua respectiva pasta basta configurar o botão que vai colocar a data dentro do textbox selecionado....

03. Configuração do Botão com referencia a Textbox que vai receber a data.

O botão funcionará adicionando a data selecionada no form do calendário a Textbox relacionada no código do Botão...

04. Seleção da Data

Vídeo com mais detalhes da "Instalação" do calendário....

Créditos do código:
 www.ambienteoffice.com.br, Felipe Gualberto.

Att.

Renam F. Ruthes