Salvar PDF com nome...
 
Notifications
Clear all

Salvar PDF com nome e destino determinados em células específicas


Cyllacelos
Posts: 4
Registered
Topic starter
(@cyllacelos)
New Member
Entrou: 2 meses atrás

Bom dia, pessoal! 

Sou iniciante e estou trabalhando em uma planilha onde preciso criar um botão para salvar uma área selecionada em PDF, com nome e destino determinados em uma célula. 

Ex.:

A pessoa terá um campo para preencher com o endereço da pasta que ela deseja salvar o exames automaticamente ("Configurações do exame!B26"). Esta célula, na verdade vem assim: ='Configurações do exame'!B26, porém acho que precia tirar o ' pra não dar erro? De qualquer forma tentei com e sem e não deu jeito.

E o nome do arquivo deverá ser o nome do paciente que consta na célula ("Audiograma!X1")

Esta é a área que eu preciso imprimir : ("A1:U55").

Encontrei este código que cria automaticamente uma pasta e funcionou perfeitamente e gostei muito da proposta,   mas o PDF não abriu, com um erro que de que o documento não é um documento em PDF válido. E agora parou de duvidar do nada, nem gerando PDF invadido está. 

Sub CriarPastas()
Dim DATA, Dia, Mes, Ano As String

DATA = Date
Dia = Left(DATA, 2)
Mes = Right(Left(DATA, 5), 2)
Ano = Right(DATA, 4)

'Criar objeto
Set fso = CreateObject("Scripting.FileSystemObject")

'Se não existir a pasta "NomedaPasta", ela é criada.
If Not fso.FolderExists("C:\EasyAudio\") Then
MkDir "C:\EasyAudio\"
End If

'Se não existir a pasta do ano atual dentro da "NomedaPasta", ela é criada.
If Not fso.FolderExists("C:\EasyAudio\" & Ano) Then
MkDir "C:\EasyAudio\" & Ano
End If

'Se não existir a pasta do mês atual dentro da pasta do ano atual, ela é criada.
If Not fso.FolderExists("C:\EasyAudio\" & Ano & "\" & Mes) Then
MkDir "C:\EasyAudio\" & Ano & "\" & Mes
End If

'Se não existir a pasta do dia atual dentro da pasta do mês atual, ela é criada.
If Not fso.FolderExists("C:\EasyAudio\" & Ano & "\" & Mes & "\" & Dia) Then
MkDir "C:\EasyAudio\" & Ano & "\" & Mes & "\" & Dia
End If

'Cria o caminha que será salvo o arquivo.
NameFolder = "C:\EasyAudio\" & Ano & "\" & Mes & "\" & Dia
'Cria o nome do Arquivo, extensão ".xls", troque extensão caso necessário.
NameFile = Range("Audiograma!x1") & " " & Format(Now, "dd_mm_yyyy-hh.mm") & ".pdf"
'Salva o Arquivo.
ThisWorkbook.SaveAs (NameFolder & "\" & NameFile)
End Sub

Este outro também funcionou, porém aqui preciso colocar o destino específico. Não consegui fazer com ele buscasse o destino na célula.

Sub SalvarPDF()

ChDir "C:\Users\prisc\Desktop\Audiometrias"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Range("Audiograma!X1"), Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

End Sub

Podem me ajudar? 

Desde já agradeço muito. 

Responder
Tags do Tópico
4 Respostas
4 Respostas
carlosrgs
Moderator
(@carlosrgs)
Entrou: 7 anos atrás

Honorable Member
Posts: 620

Bom dia @cyllacelos 

Não sou expert em VBA, mas utilizo esse código para salvar em PDF

Dim NovoNome As String
NovoNome = "C:\relato\" & ActiveSheet.Range("K2").Value & ".pdf"
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=NovoNome, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

 

O endereço mais o nome do arquivo é digitado ou informado na célula K2

"Uma sugestão, é que se você está deixando em aberto para alguém digitar o endereço, está bem passivo de digitarem errado, então pesquisar algo para resolver esse B.O."

Responder
Cyllacelos
Registered
(@cyllacelos)
Entrou: 2 meses atrás

New Member
Posts: 4

@carlosrgs obrigada,  mas não deu certo.

Fiz a substituição de K2 pela referência da célula onde está o nome que quero dar ao arquivo e "c:\relato\ pelo meu destino no computador. Mas não salva. Além disso, pelo que entendi, dessa forma eu tenho que ter uma pasta pré-determinada no computador né? 

A minha intenção é criar os 2 botões: um em que a pasta seja gerada automaticamente, como no primeiro código, e outro que vá para o destino que a pessoa escolher e colocar o caminho na célula ("Configurações do Exame!B26"). O segundo código quase funciona, porém não sei como fazer o ChDir remeter ao endereço da célula. 

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@cyllacelos 

Poste um modelo do seu arquivo com dados fictícios quem sabe fica mais fácil de te ajudar.

Analisando somente pelo código que postou não tem o que dar errado nele.

O primeiro código seu esta salvando como seu arquivo em pdf nestas linhas.

'Cria o nome do Arquivo, extensão ".xls", troque extensão caso necessário.
NameFile = Range("Audiograma!x1") & " " & Format(Now, "dd_mm_yyyy-hh.mm") & ".pdf"
'Salva o Arquivo.
ThisWorkbook.SaveAs (NameFolder & "\" & NameFile)

O código que o carlos postou esta exportando um pdf do seu arquivo.

 

Responder
Cyllacelos
Registered
(@cyllacelos)
Entrou: 2 meses atrás

New Member
Posts: 4

@teleguiado muito obrigada! 

Eu consegui resolver ontem e postei as soluções dos 2 códigos aqui, está aguardando moderação. 

No caso deste código que você citou, o problema estava em "ThisWorkbook.SaveAs". Não o dá pra salvar a pasta de trabalho em PDF. Quando troquei para salvar planilha, funcionou e o PDF abriu perfeitamente. 

Responder