none
Macro PDF RRS feed

  • Pergunta

  • Como incluir nesta macro ANO.MES.DIA no inicio da captação automatica do nome do range G5

    Sub PDFActiveSheet_Automatic()
    'Macro SALVAR PDF com captação de nome automatico
    
    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"
    
    'G5 é o Range que determina o nome automaticamente do arquivo
    strPathFile = Range("G5")
    
    '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



    segunda-feira, 15 de abril de 2019 12:54

Respostas

  • Olá tenta o código...

    Sub PDFActiveSheet_Automatic()
    'Macro SALVAR PDF com captação de nome automatico
    
    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"
    
    'G5 é o Range que determina o nome automaticamente do arquivo
    strPathFile = strPath & Format(Now, "yyyy.mm.dd") & Range("G5") & ".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


    Se ajudou, marque como resposta! Obrigado.

    • Marcado como Resposta BárbaraBettanin terça-feira, 16 de abril de 2019 10:45
    segunda-feira, 15 de abril de 2019 15:52

Todas as Respostas

  • Olá tenta o código...

    Sub PDFActiveSheet_Automatic()
    'Macro SALVAR PDF com captação de nome automatico
    
    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"
    
    'G5 é o Range que determina o nome automaticamente do arquivo
    strPathFile = strPath & Format(Now, "yyyy.mm.dd") & Range("G5") & ".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


    Se ajudou, marque como resposta! Obrigado.

    • Marcado como Resposta BárbaraBettanin terça-feira, 16 de abril de 2019 10:45
    segunda-feira, 15 de abril de 2019 15:52
  • Muito obrigada!

    Funcionou perfeitamente

    terça-feira, 16 de abril de 2019 10:45