Hello folks, Estou com um probleminha aqui, gostaria de filtrar os aniversariantes do mes da listbox, e gostaria tambem de ocultar os simbolos "|" da listbox e manter somente na base de dados .txt. Gostaria também de fazer o botao Editar funcionar. Segue o codigo até o momento e o link para download. Desde já agradeço.
Option Explicit
Private Sub UserForm_Initialize()
With ComboBox1
.AddItem "01 - Janeiro"
.AddItem "02 - Fevereiro"
.AddItem "03 - Março"
.AddItem "04 - Abril"
.AddItem "05 - Maio"
.AddItem "06 - Junho"
.AddItem "07 - Julho"
.AddItem "08 - Agosto"
.AddItem "09 - Setembro"
.AddItem "10 - Outubro"
.AddItem "11 - Novembro"
.AddItem "12 - Dezembro"
End With
Call Cria_Pasta
Call PreencheListbox
End Sub
Private Sub CommandButton1_Click()
If TextBox1 = "" Or TextBox2 = "" Or TextBox3 = "" Then
MsgBox "Preencha todos os campos", vbInformation, "Atenção"
Else
SalvaInfo VBA.Trim(TextBox1.Text) & "|" & VBA.Trim(TextBox2.Text) & "|" & VBA.Trim(TextBox3.Text)
Call Limpar
End If
Call PreencheListbox
End Sub
Sub Limpar()
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
End Sub
Sub PreencheListbox() 'preencher listbox users
Dim sTemp As String
Dim vrTemp As Variant
ListBox1.Clear
On Error Resume Next
Dim LineofText As Variant
Dim archivo As Variant
' Open the file for Input.
Open ThisWorkbook.Path & "\REGISTRO\users.txt" For Input As #1
archivo = ThisWorkbook.Path & "\REGISTRO\users.txt"
If Dir(archivo) = "" Then
MsgBox "ARQUIVO não ENCONTRADO. FOI CRIADO UMA PASTA 'REGISTRO' NO MESMO LOCAL DESTE ARQUIVO EXCEL"
Exit Sub
End If
Open archivo For Input As #1
' Read each line of the text file into a single string
' variable.
Do While Not EOF(1)
'Line Input #1, LineofText
Line Input #1, LineofText
ListBox1.AddItem LineofText
vrTemp = Split(LineofText, "|")
Loop
' Close the file.
Close #1
End Sub
Private Sub ListBox1_Change()
TextBox1.Text = ListBox1.List(ListBox1.ListIndex, 0)
'TextBox2.Text = ListBox1.List(ListBox1.ListIndex, 1)
'TextBox3.Text = ListBox1.List(ListBox1.ListIndex, 2)
End Sub
Sub SalvaInfo(LogMessage As String)
Dim LogFileName As String
Dim ConferePasta As String
Dim FileNum As Integer
ConferePasta = ThisWorkbook.Path & "\REGISTRO"
'Definir caminho e nome do arquivo de log onde você deseja salvar
'O arquivo de log
LogFileName = ConferePasta & "\users.txt" 'nome do arquivo que sera gravado"
FileNum = FreeFile 'Próximo número de arquivo
Open LogFileName For Append As #FileNum 'Cria o arquivo se ele não existir
Print #FileNum, LogMessage 'Escrever informações no final do arquivo de texto
Close #FileNum 'Fechar o arquivo
End Sub
Sub Cria_Pasta()
Dim ConferePasta As String
'Atribui caminho do diretório.
ConferePasta = ThisWorkbook.Path & "\REGISTRO"
'Testa se o diretório existe. Caso não exista, cria-se o mesmo.
If Dir(ConferePasta, vbDirectory) = "" Then MkDir ConferePasta
'cancela
End Sub
Pergunta
willianrc
Hello folks,
Estou com um probleminha aqui, gostaria de filtrar os aniversariantes do mes da listbox, e gostaria tambem de ocultar os simbolos "|" da listbox e manter somente na base de dados .txt. Gostaria também de fazer o botao Editar funcionar.
Segue o codigo até o momento e o link para download. Desde já agradeço.
Option Explicit Private Sub UserForm_Initialize() With ComboBox1 .AddItem "01 - Janeiro" .AddItem "02 - Fevereiro" .AddItem "03 - Março" .AddItem "04 - Abril" .AddItem "05 - Maio" .AddItem "06 - Junho" .AddItem "07 - Julho" .AddItem "08 - Agosto" .AddItem "09 - Setembro" .AddItem "10 - Outubro" .AddItem "11 - Novembro" .AddItem "12 - Dezembro" End With Call Cria_Pasta Call PreencheListbox End Sub Private Sub CommandButton1_Click() If TextBox1 = "" Or TextBox2 = "" Or TextBox3 = "" Then MsgBox "Preencha todos os campos", vbInformation, "Atenção" Else SalvaInfo VBA.Trim(TextBox1.Text) & "|" & VBA.Trim(TextBox2.Text) & "|" & VBA.Trim(TextBox3.Text) Call Limpar End If Call PreencheListbox End Sub Sub Limpar() TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" End Sub Sub PreencheListbox() 'preencher listbox users Dim sTemp As String Dim vrTemp As Variant ListBox1.Clear On Error Resume Next Dim LineofText As Variant Dim archivo As Variant ' Open the file for Input. Open ThisWorkbook.Path & "\REGISTRO\users.txt" For Input As #1 archivo = ThisWorkbook.Path & "\REGISTRO\users.txt" If Dir(archivo) = "" Then MsgBox "ARQUIVO não ENCONTRADO. FOI CRIADO UMA PASTA 'REGISTRO' NO MESMO LOCAL DESTE ARQUIVO EXCEL" Exit Sub End If Open archivo For Input As #1 ' Read each line of the text file into a single string ' variable. Do While Not EOF(1) 'Line Input #1, LineofText Line Input #1, LineofText ListBox1.AddItem LineofText vrTemp = Split(LineofText, "|") Loop ' Close the file. Close #1 End Sub Private Sub ListBox1_Change() TextBox1.Text = ListBox1.List(ListBox1.ListIndex, 0) 'TextBox2.Text = ListBox1.List(ListBox1.ListIndex, 1) 'TextBox3.Text = ListBox1.List(ListBox1.ListIndex, 2) End Sub Sub SalvaInfo(LogMessage As String) Dim LogFileName As String Dim ConferePasta As String Dim FileNum As Integer ConferePasta = ThisWorkbook.Path & "\REGISTRO" 'Definir caminho e nome do arquivo de log onde você deseja salvar 'O arquivo de log LogFileName = ConferePasta & "\users.txt" 'nome do arquivo que sera gravado" FileNum = FreeFile 'Próximo número de arquivo Open LogFileName For Append As #FileNum 'Cria o arquivo se ele não existir Print #FileNum, LogMessage 'Escrever informações no final do arquivo de texto Close #FileNum 'Fechar o arquivo End Sub Sub Cria_Pasta() Dim ConferePasta As String 'Atribui caminho do diretório. ConferePasta = ThisWorkbook.Path & "\REGISTRO" 'Testa se o diretório existe. Caso não exista, cria-se o mesmo. If Dir(ConferePasta, vbDirectory) = "" Then MkDir ConferePasta 'cancela End Sub
´link para download :
https://drive.google.com/file/d/10t8tDwUi6l9EIpdCRY5a5lMWt0qko9JY/view?usp=sharing
Obirgado
Editado por willianrcLink para o comentário
Compartilhar em outros sites
0 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.