Excel Macro Salvar PDF com Data e nome especifico em célula

[Max Carvalho]

Boa tarde a todos,

Tenho uma planilha com várias guias e uma delas é onde está um resumo dos dados (um relatório). Criei um botão para Salvar em PDF e encontrei o código abaixo, porém ele salva com o nome da pasta de trabalho, como não conheço de VBA, gostaria que me ajudassem a modificar esse código para que salve o PDF com o nome que contiver na célula "A1" da guia "RRB" que é a guia do relatório e no final do nome a data que foi gerado o PDF "aaaa-mm-dd".

Segue código encontrado:

 

Dim NomPastTrab As String

 

NomPastTrab = VBA.Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))

 

 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & NomPastTrab & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=True

 

Desde já agradeço a atenção...

[CasaDoHardware]

Troque esta linha:

 

NomPastTrab = VBA.Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))

 

Por algo assim:

 

NomPastTrab = Sheets("Planilha1").Range("A1").value

 

Planilha1 é o nome da guia que você pretende salvar e A1 a celula onde esta o nome que você quer na planilha.

[Jorgedlneto]

Pessoal bom dia!

Preciso de um macro para salvar como PDF vários nomes que está em outra aba da planilha. porém o nome precisa ser modificado na célula para calcular formulas de outras células. 

Exemplo: Eu preciso que o macro copie os nomes na aba SRA, um a um  e cole na célula "B2" OS.

 

Macro que gravei copiando apenas as duas primeiras células:

Sub PDF()
'
' PDF Macro
'

'
    Sheets("SRA").Select
    Range("C3").Select
    Selection.Copy
    Sheets("OS").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\jorge.neto.HSR\Desktop\Ordem de serviço\OS Automatizada_teste.pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
    Sheets("SRA").Select
    Range("C4").Select
    Selection.Copy
    Sheets("OS").Select
    Range("B2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\jorge.neto.HSR\Desktop\Ordem de serviço\OS Automatizada_teste2.pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
End Sub
Estou enviando planilha:

OS Automatizada_Modelo.xlsx

[Visitante]

 

Veja se atende.

 

Sub PDF()
 Dim c As Range
  For Each c In Sheets("SRA").Range("C3:C" & Sheets("SRA").Cells(Rows.Count, 3).End(3).Row)
   [B2] = c.Value
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
     "C:\Users\jorge.neto.HSR\Desktop\Ordem de serviço\OS Automatizada_teste.pdf", _
     Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
     :=False, OpenAfterPublish:=False
  Next c
End Sub

 

[Jorgedlneto]

18 minutos atrás, osvaldomp disse:

 

Veja se atende.

 

Sub PDF()
 Dim c As Range
  For Each c In Sheets("SRA").Range("C3:C" & Sheets("SRA").Cells(Rows.Count, 3).End(3).Row)
   [B2] = c.Value
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
     "C:\Users\jorge.neto.HSR\Desktop\Ordem de serviço\OS Automatizada_teste.pdf", _
     Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
     :=False, OpenAfterPublish:=False
  Next c
End Sub

 

@osvaldomp Muito obrigado, deu certo! 

Completei esse código com o que eu já tinha e deu certo.

 

Segue código:

 

Sub PDF()

 Dim c As Range

  For Each c In Sheets("SRA").Range("C3:C" & Sheets("SRA").Cells(Rows.Count, 3).End(3).Row)

   [B2] = c.Value

           ChDir "C:\Users\jorge.neto.HSR\Desktop\Ordem de serviço"

  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Range("b2"), Quality:= _

        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _

        OpenAfterPublish:=False

 

  Next c

End Sub

 

[Visitante]

11 minutos atrás, Jorgedlneto disse:

Completei esse código com o que eu já tinha e deu certo.

 

O que exatamente você acrescentou ao código que passei ?

[Jorgedlneto]

@osvaldomp  Só isso:

 

ChDir "C:\Users\jorge.neto.HSR\Desktop\Ordem de serviço"

[Visitante]

[Jorgedlneto]

@osvaldomp Muito, obrigado!!