All posts by Mauro Coutinho

VBA – Fomatar TextBox (Data, Telefone, CPF) nos Eventos KeyPress e Change

Publicado por Mauro Coutinho

Exemplos de mascara

Colegas, conforme solicitação em outro Forum, referente a alguns tipos de formatação em TextBox, segue as rotinas utilizando-se os Eventos KeyPress e Change :

Formata DATA : Supondo que o TextBox esteja com o nome “txtData”, a formatação ocorrerá quando da digitação :

Private Sub txtData_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
	'Limita a Qde de caracteres
	txtData.MaxLength = 8
 
	'para permitir que apenas números sejam digitados
	If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
		KeyAscii = 0
	End If
 
End Sub
 
Private Sub txtData_Change()
	'Formata : dd/mm/aa
	If Len(txtData) = 2 Or Len(txtData) = 5 Then
		txtData.Text = txtData.Text & "/"
		SendKeys "{End}", True
	End If
End Sub

Formata CPF:

Private Sub Txt_CPF_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
	'Limita a Qde de caracteres
	Txt_CPF.MaxLength = 14
 
	 Select Case KeyAscii
		Case 8, 48 To 57 ' BackSpace e numericos
		  If Len(Txt_CPF) = 3 Or Len(Txt_CPF) = 12 Then
			Txt_CPF.Text = Txt_CPF.Text & "."
			SendKeys "{End}", False
 
		ElseIf Len(Txt_CPF) = 7 Then
			Txt_CPF.Text = Txt_CPF.Text & "."
 
		ElseIf Len(Txt_CPF) = 11 Then
			Txt_CPF.Text = Txt_CPF.Text & "-"
			SendKeys "{End}", False
		  End If
 
		Case Else ' o resto é travado
			KeyAscii = 0
	  End Select
End Sub

Veja um exemplo utilizando CPF com verificação de Digito :
http://www.planilhando.com.br/forum/viewtopic.php?f=10&t=2780&p=12637&hilit=cpf#p12637

Foramata Numeros de Fones : TextBox Fone para dois numeros formato : 2222-3344 / 3333-4567 :

Private Sub txtFone_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
		'Limita a Qde de caracteres
		txtFone.MaxLength = 21     
 
		 Select Case KeyAscii
		Case 8, 48 To 57 ' BackSpace e numericos
		  If Len(txtFone) = 4 Or Len(txtFone) = 10 Then
			txtFone.Text = txtFone.Text & "-"
			SendKeys "{End}", False
 
		ElseIf Len(txtFone) = 9 Then
			txtFone.Text = txtFone.Text & " / "
 
		ElseIf Len(txtFone) = 16 Then 'Or Len(txtFone) = 20 Then
			txtFone.Text = txtFone.Text & "-"
			SendKeys "{End}", False
		  End If
 
		Case Else ' o resto é travado
			KeyAscii = 0
	  End Select
 
End Sub

Formato Horas, com validação se a Hora é valida, não tenho a fonte, ja faz um tempo que usei esta rotina :

Private Sub txtHoras_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
	Dim TimeStr As String
 
	Set TextLength = txtHoras
 
	On Error GoTo EndMacro
	With txtHoras
		If HasFormula = False Then
 
		Select Case Len(TextLength)
 
			Case 1
				TimeStr = "00:0" &amp; TextLength
			Case 2
				TimeStr = "00:" &amp; TextLength
			Case 3
				TimeStr = Left(TextLength, 1) & ":" & Right(TextLength, 2)
			Case 4
				TimeStr = Left(TextLength, 2) & ":" & Right(TextLength, 2)
 
			'Case 5 ' ex: 12345 = 01:23:45
			'        TimeStr = Left(TextLength, 1) & ":" & Mid(TextLength, 2, 2) & ":" & Right(TextLength, 2)
			'Case 6 ' ex: 123456 = 12:34:56
			'        TimeStr = Left(TextLength, 2) & ":" & Mid(TextLength, 3, 2) & ":" & Right(TextLength, 2)
 
			Case Else
			  MsgBox "HORA EM BRANCo !!!"
					  'With TextBox1
					  '    .SetFocus
						  '.SelStart = 0
						  '.SelLength = Len(.Text)
					'  End With
			  Exit Sub
 
		End Select
			Application.EnableEvents = False
			Formula = TimeValue(TimeStr)
			txtHoras = TimeStr
			sCancel = False
		End If
	End With
 
	GoTo Fim
 
EndMacro:
 
	MsgBox "HORA Inválida !!!"
		  With txtHoras
		   .SetFocus
		   .SelStart = 0
		   .SelLength = Len(.Text)
	  End With
	  sCancel = True
 
Fim:
	Application.EnableEvents = True
End Sub
 
Private Sub txtHoras_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Limita a Qde de caracteres
	txtHoras.MaxLength = 4
 
	Select Case KeyAscii
			Case 8, 48 To 57 ' BackSpace e numericos
			  'If Len(txtHoras) = 2 Or Len(txtHoras) = 6 Then
			  '  txtHoras.Text = txtHoras.Text & ":"
				SendKeys "{End}", False
			 ' End If
			Case Else ' o resto é travado
				KeyAscii = 0
		  End Select
End Sub

Formata Textbox somente com um numero de Telefone e (dd), Formato (xx) xxxx-xxxx:

Private Sub txtFone_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
	'Limita a Qde de caracteres
	txtFone.MaxLength = 14
 
	'Formato (xx) xxxx-xxxx
	If Len(txtFone) = 0 Then
		txtFone.Text = "("
	End If
 
	If Len(txtFone) = 3 Then
		txtFone.Text = txtFone & ") "
	End If
 
	If Len(txtFone) = 9 Then
		txtFone.Text = txtFone & "-"
	End If
 
End Sub

Textbox com dois numeros de Telefone e (dd), Formato (xx) xxxx-xxxx / xxxx-xxxx:

Private Sub txt2Fone_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
		'Limita a Qde de caracteres
		txt2Fone.MaxLength = 26
 
		'Formato (xx) xxxx-xxxx / xxxx-xxxx
		If Len(txt2Fone) = 0 Then
			txt2Fone.Text = "("
		End If
 
		If Len(txt2Fone) = 3 Then
			txt2Fone.Text = txt2Fone & ") "
		End If
 
		Select Case KeyAscii
 
			 Case 8, 48 To 57 ' BackSpace e numericos
			   If Len(txt2Fone) = 9 Or Len(txt2Fone) = 10 Then
				 txt2Fone.Text = txt2Fone.Text & "-"
				 SendKeys "{End}", False
 
			 ElseIf Len(txt2Fone) = 14 Then
				 txt2Fone.Text = txt2Fone.Text & " / "
 
			 ElseIf Len(txt2Fone) = 21 Then
				 txt2Fone.Text = txt2Fone.Text & "-"
				 SendKeys "{End}", False
			   End If
 
			 Case Else ' o resto é travado
			KeyAscii = 0
 
	  End Select
 
End Sub

Façam os testes, só não esqueçam de arrumarem os nomos dos controles Textbox conforme estão nas rotinas.

Quem tiver mais algumas rotinas interessantes e quiser postar fiquem a vontade.

Link para o tópico do Fórum:

http://tomasvasquez.com.br/forum/viewtopic.php?f=17&t=1505&p=7213#p7213

Excel – Adaptando o Modelo Cadastro com ListView no Excel 2007/2010

Por Mauro Coutinho

Colegas, conforme questão levantada pelo colega geroeane, no Tópico abaixo :

Form pesquisar x excel 2007
Mensagem por geroeane » Sáb Nov 19, 2011 6:34 am
viewtopic.php?f=5&t=1468

Conforme foi dito neste tópico :
Com o Office 2007 houve modificações na forma de acessar dados de e para o excel ou access.
CONEXÃO ADO – OLEDB PARA EXCEL 2007
viewtopic.php?f=5&t=721

Ou seja, para que a Conexão funcione devemos substiruir as linhas conforme abaixo :
Formulário Pesquisar procure por :
.Provider = “Microsoft.JET.OLEDB.4.0”
e substitua por :
.Provider = “Microsoft.ACE.OLEDB.12.0”
Ficando da seguinte maneira :

Set conn = New ADODB.Connection
With conn
 .Provider = "Microsoft.ACE.OLEDB.12.0"
 .ConnectionString = "Data Source=" & caminhoArquivoDados & ";Extended Properties=Excel 8.0;"
 .Open
 End With

Nos testes que fiz com o modelo anexo funcionou corretamente, mas no tópico que indiquei o Jack (JJACKLS) disse que para ele foi necessário baixar o driver para canexão OLE.

Façam os testes e qualquer duvida retornem neste tópico do fórum:

http://www.tomasvasquez.com.br/forum/viewtopic.php?f=16&p=7045

Modelo Cadastro v3 – Excel 2007

ModeloCadastro2007LView.rar

Dicas – Tela Cheia (Fullscreen) Excel 2007

Do colega Mauro Coutinho do nosso fórum

Colegas, na Versão Excel 2007, após aplicarmos uma das rotinas convencionais utilizada na v 2003 para deixarmos com a aparencia de tela cheia (FullScreen),se MINIMIZARMOS a tela e depois MAXIMIZARMOS os menus reaparecem.

Então, vale lembrar que isto não ocorre no Excel 2003, mas no Excel 2007 as opções não são mantidas, pelo simples fato do Excel 2007 utilizar “Ribbons”, então para se evitar isto devemos utilizar as rotinas abaixo :

Mais uma vez lembrando, é para Excel 2007:

    Sub TelaCheia_On()
        'Oculta todos os Menus (Ribbons)
        Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
 
        Application.DisplayFormulaBar = False
        ActiveWindow.DisplayHeadings = False
 
        With ActiveWindow
            .DisplayHorizontalScrollBar = False
            .DisplayVerticalScrollBar = False
            .DisplayWorkbookTabs = False
            .DisplayHeadings = False
            .DisplayZeros = False
            .DisplayHeadings = False
            .DisplayGridlines = False
        End With
 
    End Sub
 
    Sub TelaCheia_Off()
        'Exibe todos os Menus (Ribbons)
        Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
 
        Application.DisplayFormulaBar = True
        ActiveWindow.DisplayHeadings = True
 
        With ActiveWindow
            .DisplayHorizontalScrollBar = True
            .DisplayVerticalScrollBar = True
            .DisplayWorkbookTabs = True
            .DisplayHeadings = True
            .DisplayZeros = True
            .DisplayHeadings = True
            .DisplayGridlines = True
        End With
 
     End Sub

Uma dica para se ocultar osRibbons e exibir somente os Menus é utilizando o confunto de Teclas “CTRL+F1”, ou enviar via SendKeys :

A Rotina abaixo não funcionará se rodar no Editor do VBA, a mesma tem dde ser chamada via opção, Caixa de Macros, Excutar, ou “ALT+F8” escolher a rotina “OcultaRibbon” e Excutar.

    Sub OcultaRibbon()
        Application.SendKeys "^{F1}", True
    End Sub

Ainda não dominei todas as tecnicas destes Ribbon, existe tambem a opção de se Personalizar criando um arquivo XML, mas ainda estou estudando aos poucos, mas, pelo pouco que vi até o momento sobre personalização no excel 2007, esta dica é bem simples e aplicável, mas como eu disse, existem outras formas de se lidar com isto, criando personalizações bem mais elaboradas, e para isto usamos arquivo XML.
Não da para repassar tudo aqui, mas de uma olhada no link abaixo, tem um tutorial de personalização, e como eu aina estou estudando a respeito e devido ao meu local de trabalho só ter a v 2003, não pude me aprofundar mais, mas vejam que não é tão dificil :

Um guia para personalizar a Faixa de Opções do 2007 Office
http://64.4.10.145/pt-br/magazine/dd633481

Existe até um programa que pode ser baixado da Microsot para facilitar.

Microsoft Office 2007 Custom UI Editor
http://microsoft-office-2007-custom-ui- … ormer.com/

Façam os testes, e qualquer duvida retornem no Forum:

http://www.tomasvasquez.com.br/forum/viewtopic.php?f=17&p=6855#p6855