none
VBA: salvar como e exportar PDF em botão RRS feed

  • Pergunta

  • Ola povo, Eu encontrei esse código que salva o arquivo com o nome determinado em uma célula e o local do disco determinado em outra célula. Acontece que o arquivo é salvo sem a extensão de arquivo (.xxx), e quero saber como se pode inserir a extensão no código. 

    Além disso, gostaria de adaptar o código para que ele exportasse o projeto em pdf

    Sub CommandButton2_Click()
    
    Dim pasta As String
    Dim nome_arquivo As String
    
    pasta = Range("G1").Value
    
    nome_arquivo = Range("A12".xlms).Value
    
    
        ActiveWorkbook.SaveAs Filename:=pasta & nome_arquivo _
            , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    
        
        MsgBox "Salvo com sucesso!" + Chr(13) + Chr(13) & nome_arquivo
    
    End Sub

    Vlww

    domingo, 2 de março de 2014 00:56

Respostas

  • Olá

    Uma sugestão.

    Grave este código na folha de macro de uma palnilha e atribua a um botão.

    Sub GravaArquivo()
        Dim V_Caminho As String 'Caminho completo local de gravação - Drive\Pasta\....
        Dim V_NomeArq As String  'Nome do arquivo
        Dim V_TipoGravacao As Integer 'Convencionar um codigo por exemplo:
                '1- Salva arquivo habilitado para macro,
                '2- Salva planilha ativa em PDF e
                '3- Salva toda pasta em PDF
       
        On Error GoTo MsgErro 'Mostrara uma msg se houver erro na execução da macro
       
        V_Caminho = ActiveSheet.Range("A1").Value  'células com as informações
        V_NomeArq = ActiveSheet.Range("A2").Value
        V_TipoGravacao = ActiveSheet.Range("A3").Value
       
        'Selecionar tipo de gravação
        Select Case V_TipoGravacao
            Case 1
                ActiveWorkbook.SaveAs Filename:=V_Caminho & "\" & V_NomeArq, _
                FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
                MsgBox "Gravação de " & V_Caminho & "\" & V_NomeArq & Chr(13) _
                        & "          Com SUCESSO"
            Case 2
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                V_Caminho & "\" & V_NomeArq, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                OpenAfterPublish:=True
            Case 3
                ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                V_Caminho & "\" & V_NomeArq, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
            Case Else
                MsgBox "Tipo de gravação não determinado ou invalido"
        End Select
    Exit Sub
    MsgErro:
        MsgBox "Erro Nr. " & Err & " - " & Error(Err)
    End Sub

    O métodos acima referidos tem outros parâmetros que podem ser utilizados, como atribuir uma senha, etc.

    Até

    Alberto

    terça-feira, 4 de março de 2014 03:35

Todas as Respostas

  • + uma coisinha.

    Eu queria criar um botão que quando clicado juntasse o conteúdo de 2 células em apenas 1.

    Ex.

    A1 = Amanda

    A2 = Caio

    A3 (quando clicado o botão) = Amanda Caio

    domingo, 2 de março de 2014 19:35
  • Tinha alguns erros, na verdade o código é esse:

    Sub CommandButton2_Click()
    
    Dim pasta As String
    Dim nome_arquivo As String
    
    pasta = Range("G1").Value
    
    nome_arquivo = Range("A12") & ".xlsm"
    
    
        ActiveWorkbook.SaveAs Filename:=pasta & nome_arquivo, FileFormat:= _
            xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    
        
        MsgBox "Salvo com sucesso!" + Chr(13) + Chr(13) & nome_arquivo
    
    End Sub
    

    E para juntar os dois nomes você pode usar a própria fórmula do excel CONCATEAR para juntar, porém como você disse que tem que ser em um botão então basta utilizar este código:

    Sub CommandButton2_Click()
    
    nome1 = Range("A1")
    nome2 = Range("A2")
    
    Range("A3") = nome1 & " " & nome2
    
    
    End Sub

    segunda-feira, 3 de março de 2014 13:09
  • Olá

    Uma sugestão.

    Grave este código na folha de macro de uma palnilha e atribua a um botão.

    Sub GravaArquivo()
        Dim V_Caminho As String 'Caminho completo local de gravação - Drive\Pasta\....
        Dim V_NomeArq As String  'Nome do arquivo
        Dim V_TipoGravacao As Integer 'Convencionar um codigo por exemplo:
                '1- Salva arquivo habilitado para macro,
                '2- Salva planilha ativa em PDF e
                '3- Salva toda pasta em PDF
       
        On Error GoTo MsgErro 'Mostrara uma msg se houver erro na execução da macro
       
        V_Caminho = ActiveSheet.Range("A1").Value  'células com as informações
        V_NomeArq = ActiveSheet.Range("A2").Value
        V_TipoGravacao = ActiveSheet.Range("A3").Value
       
        'Selecionar tipo de gravação
        Select Case V_TipoGravacao
            Case 1
                ActiveWorkbook.SaveAs Filename:=V_Caminho & "\" & V_NomeArq, _
                FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
                MsgBox "Gravação de " & V_Caminho & "\" & V_NomeArq & Chr(13) _
                        & "          Com SUCESSO"
            Case 2
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                V_Caminho & "\" & V_NomeArq, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                OpenAfterPublish:=True
            Case 3
                ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                V_Caminho & "\" & V_NomeArq, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
            Case Else
                MsgBox "Tipo de gravação não determinado ou invalido"
        End Select
    Exit Sub
    MsgErro:
        MsgBox "Erro Nr. " & Err & " - " & Error(Err)
    End Sub

    O métodos acima referidos tem outros parâmetros que podem ser utilizados, como atribuir uma senha, etc.

    Até

    Alberto

    terça-feira, 4 de março de 2014 03:35
  • Parabéns, vc salvou minha vida, kkkk

    Código Excelente.

    quarta-feira, 11 de maio de 2016 13:48
  • Qual é esse parametro de atribuir senha ao pdf?
    terça-feira, 13 de dezembro de 2016 18:51
  • COMO FAÇO PARA SALVAR O ARQUIVO PDF NA MESMA PASTA DO ARQUIVO XLSM?
    segunda-feira, 3 de julho de 2017 13:18
  • Alberto, ótimo código. Porém não consegui fazer com que ele Defina a area de impressão para salvar corretamente.

    Usei a Macro mais mesmo assim ele salva bagunçado. 

    Alguem pode me ajudar?

    Att;

    domingo, 29 de outubro de 2017 18:18
  • + uma coisinha.

    Eu queria criar um botão que quando clicado juntasse o conteúdo de 2 células em apenas 1.

    Ex.

    A1 = Amanda

    A2 = Caio

    A3 (quando clicado o botão) = Amanda Caio

    Sub concatenar()
       Range("A3").FormulaLocal = "=A1&"" ""&A2"
    End Sub


    quinta-feira, 11 de janeiro de 2018 13:33
  • Use essa linha de código dentro da Sub

    ActiveSheet.PageSetup.PrintArea = Range("A1:D10").Address

    Substituindo o endereço em negrito pelo intervalo que você quer imprimir!

    quinta-feira, 11 de janeiro de 2018 13:36
  • ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= ActiveWorkbook.Path & "\nomedoarquivo.pdf"
    quinta-feira, 11 de janeiro de 2018 13:59
  • Não conseguir criar o tipo de gravação....
    domingo, 19 de maio de 2019 19:53