Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Gerar TXT com nome ...
 
Notifications
Clear all

Gerar TXT com nome de celula

 
2024 - VBA & Macros
4 Posts
2 Usuários
0 Reactions
987 Visualizações
RSS
 vpeglow
(@vpeglow)
Posts: 88
Estimable Member
Topic starter
 

Boa tarde a todos,

eu uso o código abaixo para gerar TXT de uma paln que uso, porem eu queria que no me do arquivo ficasse o mesmo que esta aparecendo na célula A1 no momento que irei gerar.

Aguem poderia me ajudar?

Sub GerarBancoDeDados()
    Dim localGravacao As String
    Dim nomeArquivo As String
    Dim linhaGravar As String
    Dim ultLinha As Integer
    Dim ultColuna As Integer
    
    localGravacao = Environ("USERPROFILE") & "Desktop"
    nomeArquivo = "ERP Web" & "-" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - " & Replace(Time, ":", ".") & ".txt"
    ultLinha = Sheets("Gerador TXT").Cells(Cells.Rows.Count, "A").End(xlUp).Row
    ultCol = Sheets("Gerador TXT").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    
    'Abre o arquivo para gravação
    Open localGravacao & nomeArquivo For Output As #1
        For i = 1 To ultLinha
            For j = 1 To ultCol
                   'Concatena as colunas separando elas por ","
                   linhaGravar = linhaGravar & Sheets("Gerador TXT").Cells(i, j).Value & "|"
            Next j
            'Grava a linha no arquivo - As funções Left e Len são utilizadas para excluir a última virgula do texto
            Print #1, Left(linhaGravar, Len(linhaGravar) - 1)
            linhaGravar = ""
        Next i
    Close #1
    MsgBox "Importado sucesso.", vbInformation, "BD"
End Sub
 
Postado : 24/02/2016 12:05 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 
Sub GerarBancoDeDados()
    Dim localGravacao As String
    Dim nomeArquivo As String
    Dim linhaGravar As String
    Dim ultLinha As Integer
    Dim ultColuna As Integer
    
    localGravacao = Environ("USERPROFILE") & "Desktop"
    nomeArquivo = [A1] & " - ERP Web" & "-" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - " & Replace(Time, ":", ".") & ".txt"
    ultLinha = Sheets("Gerador TXT").Cells(Cells.Rows.Count, "A").End(xlUp).Row
    ultCol = Sheets("Gerador TXT").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    
    'Abre o arquivo para gravação
    Open localGravacao & nomeArquivo For Output As #1
        For i = 1 To ultLinha
            For j = 1 To ultCol
                   'Concatena as colunas separando elas por ","
                   linhaGravar = linhaGravar & Sheets("Gerador TXT").Cells(i, j).Value & "|"
            Next j
            'Grava a linha no arquivo - As funções Left e Len são utilizadas para excluir a última virgula do texto
            Print #1, Left(linhaGravar, Len(linhaGravar) - 1)
            linhaGravar = ""
        Next i
    Close #1
    MsgBox "Importado sucesso.", vbInformation, "BD"
End Sub
 
Postado : 24/02/2016 12:18 pm
 vpeglow
(@vpeglow)
Posts: 88
Estimable Member
Topic starter
 

Funcionou, porem eu gostaria que pegasse a celula A1 da plan3

 
Postado : 24/02/2016 1:30 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 
Sub GerarBancoDeDados()
    Dim localGravacao As String
    Dim nomeArquivo As String
    Dim linhaGravar As String
    Dim ultLinha As Integer
    Dim ultColuna As Integer
    
    localGravacao = Environ("USERPROFILE") & "Desktop"
    nomeArquivo = worksheets("Plan3").Range("a1").Value & " - ERP Web" & "-" & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " - " & Replace(Time, ":", ".") & ".txt"
    ultLinha = Sheets("Gerador TXT").Cells(Cells.Rows.Count, "A").End(xlUp).Row
    ultCol = Sheets("Gerador TXT").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    
    'Abre o arquivo para gravação
    Open localGravacao & nomeArquivo For Output As #1
        For i = 1 To ultLinha
            For j = 1 To ultCol
                   'Concatena as colunas separando elas por ","
                   linhaGravar = linhaGravar & Sheets("Gerador TXT").Cells(i, j).Value & "|"
            Next j
            'Grava a linha no arquivo - As funções Left e Len são utilizadas para excluir a última virgula do texto
            Print #1, Left(linhaGravar, Len(linhaGravar) - 1)
            linhaGravar = ""
        Next i
    Close #1
    MsgBox "Importado sucesso.", vbInformation, "BD"
End Sub
 
Postado : 24/02/2016 1:33 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico