Notifications
Clear all

Formatando TEXTBOX PARA DATA

9 Posts
4 Usuários
0 Reactions
1,529 Visualizações
(@goiko)
Posts: 0
New Member
Topic starter
 

Pessoal, Boa Tarde!

Estou com um problema, procurei no fórum mas não encontrei. caso alguém tenha visto esse problema. favor deixar o link.

tenho uma planilha de controle de embarque com muitas informações. porem preciso somente de algumas, fiz uma macro onde ela reduz o numero de colunas para somente as que eu preciso, mesmo assim a planilha fica enorme precisando de usar barra de rolagem toda hora. sem falar o fato de ter que consultar varias notas durante o dia. isso fica cansativo, pesquisei um pouco e achei uma forma de jogar todas as informações q eu preciso para o VBA. ficou show, ta importando todas colunas consigo visualizar numa boa.

porem ai que vem o problema, as TextBox que eu preciso visualizar o valor em data "dia/mês/ano", esta aparecendo só a quantidade de dias. e quando eu digito numero da NF no campo para pesquisa só aceita com 4 dígitos, não permite q eu consulte nada alem disso, principalmente códigos de postagem que são enormes.

Estou listando abaixo o código q eu estou usando. se alguém puder ajudar, fico agradecido.

Private Sub TextBox1_AfterUpdate()

Dim intervalo As Range
Dim texto As String
Dim NF As Integer
Dim pequisa
Dim mensagem
NF = TextBox1.Text
Sheets("MACROS").Select
Set intervalo = Range("A2:AH15000")

On Error GoTo trataErro

pesquisa = Application.WorksheetFunction.VLookup(NF, intervalo, 2, False)
pesq1 = Application.WorksheetFunction.VLookup(NF, intervalo, 3, False)
pesq2 = Application.WorksheetFunction.VLookup(NF, intervalo, 4, False)
pesq3 = Application.WorksheetFunction.VLookup(NF, intervalo, 5, False)
pesq4 = Application.WorksheetFunction.VLookup(NF, intervalo, 6, False)
pesq5 = Application.WorksheetFunction.VLookup(NF, intervalo, 7, False)
pesq6 = Application.WorksheetFunction.VLookup(NF, intervalo, 8, False)
pesq7 = Application.WorksheetFunction.VLookup(NF, intervalo, 9, False)
pesq8 = Application.WorksheetFunction.VLookup(NF, intervalo, 10, False)
pesq9 = Application.WorksheetFunction.VLookup(NF, intervalo, 11, False)
pesq10 = Application.WorksheetFunction.VLookup(NF, intervalo, 12, False)
pesq11 = Application.WorksheetFunction.VLookup(NF, intervalo, 13, False)
pesq12 = Application.WorksheetFunction.VLookup(NF, intervalo, 14, False)
pesq13 = Application.WorksheetFunction.VLookup(NF, intervalo, 15, False)
pesq14 = Application.WorksheetFunction.VLookup(NF, intervalo, 16, False)
pesq15 = Application.WorksheetFunction.VLookup(NF, intervalo, 17, False)
pesq16 = Application.WorksheetFunction.VLookup(NF, intervalo, 18, False)
pesq17 = Application.WorksheetFunction.VLookup(NF, intervalo, 19, False)

TextBox2.Text = pesquisa
TextBox3.Value = pesq1
TextBox4.Text = pesq2
TextBox5.Text = pesq3
TextBox6.Text = pesq4
TextBox7.Text = pesq5
TextBox8.Text = pesq6
TextBox9.Text = pesq7
TextBox10.Text = pesq8
TextBox11.Text = pesq9
TextBox12.Text = pesq10
TextBox13.Text = pesq11
TextBox14.Text = pesq12
TextBox15.Text = pesq13
TextBox16.Text = pesq14
TextBox17.Text = pesq15
TextBox18.Text = pesq16
TextBox19.Text = pesq17
TextBox1.SetFocus

Exit Sub

trataErro:
texto = "Produto não localizado!"
mensagem = MsgBox(texto, vbOKOnly + vbInformation)

End Sub

 
Postado : 12/07/2016 2:44 pm
(@mprudencio)
Posts: 0
New Member
 

Ve se ajuda

https://social.msdn.microsoft.com/Forum ... orum=vbapt

 
Postado : 12/07/2016 5:32 pm
(@lcsimao)
Posts: 20
Eminent Member
 

Eu uso a seguinte linha para ficar correto a questão da data:

Private Sub DataIni_Change()

DataIni.MaxLength = 10

If DataIni.Text Like "##" Then
    DataIni.Text = DataIni.Text & "/"
    
ElseIf DataIni.Text Like "##/##" Then
    DataIni.Text = DataIni.Text & "/"
    
ElseIf DataIni.Text Like "##/##/####" Then

Data1 = DataIni.Text

End If

End Sub
 
Postado : 12/07/2016 7:26 pm
(@goiko)
Posts: 0
New Member
Topic starter
 

Marcelo, Bom Dia!

eu cheguei a olhar esse topico ai mas nao consegui.

Simão, Bom Dia!

tambem nao deu certo esse codigo abaixo, a textbox contunua trazendo so os valores em dias.

vou deixar meu e-mail, qualquer coisa me manda um e-mail q eu mando a planilha em anexo.

[email protected]

 
Postado : 13/07/2016 6:21 am
(@edivan)
Posts: 0
New Member
 

Amigo posta um esboço da sua planilha assim fica mais fácil localizarmos a melhor e mais rápida forma de te ajudar...

Visite meu blog:

programacaopassoapasso.wordpress.com

 
Postado : 13/07/2016 1:11 pm
(@edivan)
Posts: 0
New Member
 

Quanto a quantidade de dígitos que você fala no campo de busca dá uma olhada na propriedade "MaxLength" se por acaso esta "4" pois essa propriedade determina a quantidade máxima de caracteres permitida em um textbox caso esteja alterada coloque "0" assim será liberada a permissão para inúmeros dígitos...

 
Postado : 13/07/2016 1:16 pm
(@goiko)
Posts: 0
New Member
Topic starter
 

estou mandando a planilha em anexo.

clica no botal consulta e depois digita o numero que consta na coluna "NF".

obs.: esta toda despadronizada por que ainda não fiz todas formatações no VBA.

 
Postado : 14/07/2016 8:50 am
(@edivan)
Posts: 0
New Member
 

SEGUE CÓDIGO MAIS SIMPLES QUE EU SEI FAZER

*PARA FUNCIONAR TODAS AS LINHAS COM OS DADOS DEVEM ESTAR UMA APÓS A OUTRA SEM LINHAS VAZIAS NO MEIO...

Private Sub TextBox1_AfterUpdate()

    Dim lin As Integer
    lin = 5
    
    Do Until Sheets("MACROS").Range("A" & lin).Value = ""
        If TextBox1.Text = Sheets("MACROS").Range("A" & lin).Value Then
        
        TextBox2.Text = Sheets("MACROS").Range("B" & lin).Value
        TextBox3.Text = Sheets("MACROS").Range("C" & lin).Value
        TextBox4.Text = Sheets("MACROS").Range("D" & lin).Value
        TextBox5.Text = Sheets("MACROS").Range("E" & lin).Value
        TextBox6.Text = Sheets("MACROS").Range("F" & lin).Value
        TextBox7.Text = Sheets("MACROS").Range("G" & lin).Value
        TextBox8.Text = Sheets("MACROS").Range("H" & lin).Value
        TextBox9.Text = Sheets("MACROS").Range("I" & lin).Value
        TextBox10.Text = Sheets("MACROS").Range("J" & lin).Value
        TextBox11.Text = Sheets("MACROS").Range("K" & lin).Value
        TextBox12.Text = Sheets("MACROS").Range("L" & lin).Value
        TextBox13.Text = Sheets("MACROS").Range("M" & lin).Value
        TextBox14.Text = Sheets("MACROS").Range("N" & lin).Value
        TextBox15.Text = Sheets("MACROS").Range("O" & lin).Value
        TextBox16.Text = Sheets("MACROS").Range("P" & lin).Value
        TextBox17.Text = Sheets("MACROS").Range("Q" & lin).Value
        TextBox18.Text = Sheets("MACROS").Range("R" & lin).Value
        TextBox19.Text = Sheets("MACROS").Range("S" & lin).Value
        TextBox1.SetFocus
            Exit Do
        End If
    lin = lin + 1
    Loop

End Sub

Visite meu blog:

programacaopassoapasso.wordpress.com

 
Postado : 14/07/2016 10:07 am
(@goiko)
Posts: 0
New Member
Topic starter
 

Muito obrigado edivan, ficou perfeito.

e obrigado a todos também que se dispuseram a me ajudar.

 
Postado : 14/07/2016 10:59 am