none
Macro Salvar PDF RRS feed

  • Pergunta

  • Queria utilizar essa macro para salvar determinado range

    Exemplo: somente range E6:I60

    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"
    
    'F5 é o Range que determina o nome automaticamente do arquivo e yyyy.mm.dd é o tipo de formatação da data
    strPathFile = strPath & Format(Now, "yyyy.mm.dd") & Range("F5") & ".pdf"
    
    '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 gerado com sucesso: " _
          & vbCrLf _
          & myFile
    End If
    
    exitHandler:
        Exit Sub
    ErrHandler:
        MsgBox "Não foi possível gerar o PDF", vbCritical
        Resume exitHandler
    End Sub

    sexta-feira, 30 de agosto de 2019 19:58