none
Macro PDF RRS feed

  • Pergunta

  • Tenho esse código macro e gostaria que fosse adaptado para buscar o nome do arquivo no range C2 e manter a escolha do diretório

    Sub PDFActiveSheet()
    
    Dim wsA As Worksheet
    Dim wbA As Workbook
    Dim strTime As String
    Dim strName As String
    Dim strPath As String
    Dim strFile As String
    Dim strPathFile As String
    Dim myFile As Variant
    On Error GoTo ErrHandler
    
    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet
    strTime = Format(Now(), "dd.mm.yyyy\_hh.mm")
    
    'Pegar diretório atual, se estiver salvo
    strPath = wbA.Path
    If strPath = "" Then
      strPath = Application.DefaultFilePath
    End If
    strPath = strPath & "\"
    
    'Trocar espeços no nome
    strName = Replace(wsA.Name, " ", "")
    strName = Replace(strName, ".", "_")
    
    'Criação de nome padrão
    strFile = strName & "_" & strTime & ".pdf"
    strPathFile = strPath & strFile
    
    ' Escolher diretório
    myFile = Application.GetSaveAsFilename _
        (InitialFileName:=strPathFile, _
            FileFilter:="PDF Files (*.pdf), *.pdf", _
            Title:="Selecione diretório e nome do arquivo")
    
    'Gerar pdf no diretório escolhido
    If myFile <> "Falso" Then
        wsA.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=myFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        'Mensagem de confirmação
        MsgBox "PDF criado com sucesso: " _
          & vbCrLf _
          & myFile
    End If
    
    exitHandler:
        Exit Sub
    ErrHandler:
        MsgBox "Não foi possível gerar o PDF", vbCritical
        Resume exitHandler
    End Sub
    

    quinta-feira, 13 de dezembro de 2018 09:29

Respostas

  • Por favor marca como respondido e vota pelo meu post , isso me ajuda e ajuda os outros usuários do forum, obrigado.

    meu email : jh_gcc@hotmail.com

    Sub PDFActiveSheet()

    Dim wsA As Worksheet
    Dim wbA As Workbook
    Dim strTime As String
    Dim strName As String
    Dim strPath As String
    Dim strFile As String
    Dim strPathFile As String
    Dim myFile As Variant
    On Error GoTo ErrHandler

    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet
    strTime = Format(Now(), "dd.mm.yyyy\_hh.mm")

    'Pegar diretório atual, se estiver salvo
    strPath = wbA.Path
    If strPath = "" Then
      strPath = Application.DefaultFilePath
    End If
    strPath = strPath & "\"

    'Trocar espeços no nome
    strName = Replace(wsA.Name, " ", "")
    strName = Replace(strName, ".", "_")

    'Criação de nome padrão
    strFile = strName & "_" & strTime & ".pdf"
    strPathFile = Range("c2")

    ' Escolher diretório
    myFile = Application.GetSaveAsFilename _
        (InitialFileName:=strPathFile, _
            FileFilter:="PDF Files (*.pdf), *.pdf", _
            Title:="Selecione diretório e nome do arquivo")

    'Gerar pdf no diretório escolhido
    If myFile <> "Falso" Then
        wsA.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=myFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        'Mensagem de confirmação
        MsgBox "PDF criado com sucesso: " _
          & vbCrLf _
          & myFile
    End If

    exitHandler:
        Exit Sub
    ErrHandler:
        MsgBox "Não foi possível gerar o PDF", vbCritical
        Resume exitHandler
    End Sub

    • Marcado como Resposta BárbaraBettanin quinta-feira, 13 de dezembro de 2018 19:47
    quinta-feira, 13 de dezembro de 2018 19:12

Todas as Respostas

  • Por favor marca como respondido e vota pelo meu post , isso me ajuda e ajuda os outros usuários do forum, obrigado.

    meu email : jh_gcc@hotmail.com

    Sub PDFActiveSheet()

    Dim wsA As Worksheet
    Dim wbA As Workbook
    Dim strTime As String
    Dim strName As String
    Dim strPath As String
    Dim strFile As String
    Dim strPathFile As String
    Dim myFile As Variant
    On Error GoTo ErrHandler

    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet
    strTime = Format(Now(), "dd.mm.yyyy\_hh.mm")

    'Pegar diretório atual, se estiver salvo
    strPath = wbA.Path
    If strPath = "" Then
      strPath = Application.DefaultFilePath
    End If
    strPath = strPath & "\"

    'Trocar espeços no nome
    strName = Replace(wsA.Name, " ", "")
    strName = Replace(strName, ".", "_")

    'Criação de nome padrão
    strFile = strName & "_" & strTime & ".pdf"
    strPathFile = Range("c2")

    ' Escolher diretório
    myFile = Application.GetSaveAsFilename _
        (InitialFileName:=strPathFile, _
            FileFilter:="PDF Files (*.pdf), *.pdf", _
            Title:="Selecione diretório e nome do arquivo")

    'Gerar pdf no diretório escolhido
    If myFile <> "Falso" Then
        wsA.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=myFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        'Mensagem de confirmação
        MsgBox "PDF criado com sucesso: " _
          & vbCrLf _
          & myFile
    End If

    exitHandler:
        Exit Sub
    ErrHandler:
        MsgBox "Não foi possível gerar o PDF", vbCritical
        Resume exitHandler
    End Sub

    • Marcado como Resposta BárbaraBettanin quinta-feira, 13 de dezembro de 2018 19:47
    quinta-feira, 13 de dezembro de 2018 19:12
  • Tem como incluir no inicio do nome captado pelo range C2 a data assim ANO.MES.DIA
    quinta-feira, 13 de dezembro de 2018 19:48