Ir para conteúdo
Fórum Script Brasil
  • 0

Listar Aniversariantes do Mes no arquivo .txt


willianrc

Pergunta

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 willianrc
Link para o comentário
Compartilhar em outros sites

0 respostass a esta questão

Posts Recomendados

Até agora não há respostas para essa pergunta

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.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,1k
    • Posts
      651,8k
×
×
  • Criar Novo...