none
Código VBA RRS feed

  • Pergunta

  • Bom dia Pessoal!

     

    Estou ainda galgando na programação VBA ... criei uma especie de comanda de duplicatas na empresa,  o programa já está rodando perfeitamente salvando com: DATA/ horas e min/ O que eu gostaria era: de acrescentar um conteúdo da célula B4 p/ salvar automaticamente no nome do arquivo, como posso fazer isso amigos? segue o código VBA:

    Dim SvInput As String
        Dim Data As String
        Dim var_MENSAGEM
        Dim Nome As String
        
        'selecionar a tabela, "Banco" é o nome dela
        Sheets("plan1").Select
        
        'Para determinar o fim da planilha com o nome "pdff", e "Banco" o nome da planilha
        pdff = Worksheets("plan1").UsedRange.Rows.Count
        
        'Selecionar o inicio e o fim da planilha
        Range("A2:C" & pdff).Select
        
        Nome = InputBox("Digite o nome para o relatório", "Gerar Relatório PDF")
        Data = VBA.Format(Date, "dd-mm-yyyy") & " " & "Hora " & Format(Time(), "hh-mm-ss") & "" & ".pdf"
        SvInput = ThisWorkbook.Path & Application.PathSeparator & Nome & "_" & Data & ".pdf"
            With ActiveSheet
                .ExportAsFixedFormat _
                Type:=x1TypePDF, _
                Filename:=SvInput, _
                OpenAfterPublish:=True
            End With
            
        'por Max Gomes
    End Sub

    quarta-feira, 26 de julho de 2017 14:02

Respostas

  • Sub teste()
    
    Dim SvInput As String
        Dim Data As String
        Dim var_MENSAGEM
        Dim Nome As String
        Dim texto As String
        'selecionar a tabela, "Banco" é o nome dela
        Sheets("plan1").Select
        
        'Para determinar o fim da planilha com o nome "pdff", e "Banco" o nome da planilha
        pdff = Worksheets("plan1").UsedRange.Rows.Count
        
        'Selecionar o inicio e o fim da planilha
        Range("A2:C" & pdff).Select
        
        Nome = InputBox("Digite o nome para o relatório", "Gerar Relatório PDF")
        Data = VBA.Format(Date, "dd-mm-yyyy") & " " & "Hora " & Format(Time(), "hh-mm-ss") & "" & ".pdf"
        texto = ThisWorkbook.Sheets("plan1").Range("B4").Value
        SvInput = ThisWorkbook.Path & Application.PathSeparator & Nome & "_" & Data & texto & ".pdf"
            With ActiveSheet
                .ExportAsFixedFormat _
                Type:=x1TypePDF, _
                Filename:=SvInput, _
                OpenAfterPublish:=True
            End With
            
        'por Max Gomes
    End Sub


    Anderson Diniz

    • Sugerido como Resposta AndersonFDiniz2 quarta-feira, 26 de julho de 2017 14:15
    • Marcado como Resposta Código VBA quarta-feira, 26 de julho de 2017 14:34
    quarta-feira, 26 de julho de 2017 14:15

Todas as Respostas

  • Sub teste()
    
    Dim SvInput As String
        Dim Data As String
        Dim var_MENSAGEM
        Dim Nome As String
        Dim texto As String
        'selecionar a tabela, "Banco" é o nome dela
        Sheets("plan1").Select
        
        'Para determinar o fim da planilha com o nome "pdff", e "Banco" o nome da planilha
        pdff = Worksheets("plan1").UsedRange.Rows.Count
        
        'Selecionar o inicio e o fim da planilha
        Range("A2:C" & pdff).Select
        
        Nome = InputBox("Digite o nome para o relatório", "Gerar Relatório PDF")
        Data = VBA.Format(Date, "dd-mm-yyyy") & " " & "Hora " & Format(Time(), "hh-mm-ss") & "" & ".pdf"
        texto = ThisWorkbook.Sheets("plan1").Range("B4").Value
        SvInput = ThisWorkbook.Path & Application.PathSeparator & Nome & "_" & Data & texto & ".pdf"
            With ActiveSheet
                .ExportAsFixedFormat _
                Type:=x1TypePDF, _
                Filename:=SvInput, _
                OpenAfterPublish:=True
            End With
            
        'por Max Gomes
    End Sub


    Anderson Diniz

    • Sugerido como Resposta AndersonFDiniz2 quarta-feira, 26 de julho de 2017 14:15
    • Marcado como Resposta Código VBA quarta-feira, 26 de julho de 2017 14:34
    quarta-feira, 26 de julho de 2017 14:15
  • Perfeito amigo, muitíssimo Obg ! 
    quarta-feira, 26 de julho de 2017 14:33