Priscylla Vital Vasconcelo

Consegui resolver, pessoal! Neste código que inicialmente salva o arquivo numa pasta pré-determinada e "fixa" no computador e eu queria fazer referência a um caminho digitado numa célula, Sub SalvarPDF() If Range("Configurações!c66").Value <> "" Then Dim Pasta As String Dim nome_arquivo As String 'Em ("Configurações!c66") eu coloquei o caminho da pasta. Era uma ordem assim: Escreva aqui o local que você deseja salvar o arquivo, 'assim o código vai puxar automaticamente a pasta que qualquer pessoa escolher. O endereço na célula precisa terminar com \. 'O nome do arquivo é o texto que consta em Range("nomes!f1" e "Nomes!h4") Pasta = Range("Configurações!c66").Value nome_arquivo = Range("nomes!F1") & " " & Format(Now, "dd_mm_yyyy") & "-" & Range("nomes!H4") & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _ (Pasta & "\" & nome_arquivo), Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=False End If MsgBox "Salvo com sucesso!" + Chr(13) + Chr(13) & NameFile + Chr(13) + Chr(13) & NameFolder o erro era que minha referência era uma planilha de nome composto "Configurações do exame", quando mudei para apenas "Configurações" funcionou e ficou assim: No outro código, cujo o intuito era criar uma nova pasta e salvar os arquivos nela com o nome do arquivo referente ao texto contido em determinada célula e estava dando erro na hora de abrir o PDF, a falha era na última linha do código que falava pra salvar ThisWorkBook. Para .PDF isso não funcionou, apenas para .xlsm. Sendo assim, o código ficou desta forma e funcionando bem! Sub CriarPasta() 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:\NomedaPasta\" End If 'Se não existir a pasta do ano atual dentro da "NomedaPasta", ela é criada. If Not fso.FolderExists("C:\NomedaPasta\" & Ano) Then MkDir "C:\NomedaPasta\" & 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:\NomedaPasta\" & Ano & "\" & Mes) Then MkDir "C:\NomedaPasta\" & 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:\NomedaPasta\" & Ano & "\" & Mes & "\" & Dia) Then MkDir "C:\NomedaPasta\" & Ano & "\" & Mes & "\" & Dia End If 'Cria o caminha que será salvo o arquivo. NameFolder = "C:\NomedaPasta\" & Ano & "\" & Mes & "\" & Dia 'Cria o nome do Arquivo, extensão ".xls", troque extensão caso necessário. NameFile = Range("x1") & " " & Format(Now, "dd_mm_yyyy") & ".pdf" 'Salva o Arquivo. ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ (NameFolder & "\" & NameFile), Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=False MsgBox "Salvo com sucesso!" + Chr(13) + Chr(13) & NameFile + Chr(13) + Chr(13) & NameFolder End Sub Desculpem a forma que postei inicialmente. É a minha primeira vez em fóruns e eu postei do celular, não tinha visto como fazer esta formatação. Até a próxima!

Bom dia, pessoal! Sou iniciante e estou trabalhando em uma planilha onde preciso criar um botão para salvar uma área selecionada em PDF. Uma com nome e destino determinados em uma célula e outro com a criação automática de uma pasta dentro de 😄 salvando os arquivos lá dentro com o nome que estiver em determinada 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. 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.