Ir para conteúdo
Fórum Script Brasil
  • 0

salvar arquivo em pdf em pastas diferentes sendo o nome da pasta e do arquivo valores contidos em celulas


marcelo carlos

Pergunta

Preciso criar uma rotina VBA para salvar um arquivo(formulário) no formato PDF dentro de pastas nomeadas de 1 a 100 no diretório do meu pc.Sempre que digitar ,por exemplo ,o número 2 na célula D6 e o número 2.1 na célula D4 ,minha rotina deverá salvar esse arquivo com o nome 2.1 dentro da pasta 2.Os valores digitados na célula D6 serão números de 1 a 100 que indicarão em qual das pastas pré definidas do meu diretório o arquivo será salvo com o nome referente ao valor contido na celula d4.Já consegui salvar o documento com o nome desejado porém não dentro das pastas específicas.

 

Link para o comentário
Compartilhar em outros sites

9 respostass a esta questão

Posts Recomendados

  • 1

Olá marcelo carlos

Tente adpatar a sua necessidade:

Sub salvarArquivo()

    Sheets("salvarArquivo").Select
    
    If ActiveSheet.Cells(6, 4).Value = Empty Then Exit Sub
    
    If ActiveSheet.Cells(4, 4).Value = Empty Then Exit Sub
                                
    If Dir(ActiveSheet.Cells(6, 5).Value & ActiveSheet.Cells(6, 4).Value, vbDirectory) <> Empty Then
            
    Else
    
        MsgBox "diretório inexistente ou incorreto"
        
        Exit Sub
        
    End If

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ActiveSheet.Cells(6, 5).Value & ActiveSheet.Cells(6, 4).Value & "\" & ActiveSheet.Cells(4, 4).Value & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    
End Sub

image.png.e92168303bbcab62363f85934a48735b.png

image.thumb.png.3eda54042f659faff543672a1d5dbe72.png

Veja se é por aí...

Link para o comentário
Compartilhar em outros sites

  • 0

Boa noite marcio.rodrigues 

Obrigado por enviar a resposta.Estou usando o código abaixo e também está dando certo quanto a demanda inicial porém agora surgiu uma nova necessidade.Toda vez que digitamos na célula D4 um número de um arquivo já existente e rodamos a macro, o novo arquivo suprime o anterior ,gerando a perda do arquivo.Preciso fazer com que o código não gere um novo arquivo com o mesmo nome do arquivo já existente  e envie uma msg para o usuário via msg Box alertando sobre o erro.Como fazer isso aproveitando o código abaixo?Desde já obrigado.

 

 

Priva te Sub CommandButton1_Click()

 Application.ScreenUpdating = False

 Dim caminho As String

 Dim pasta As Object, NomePasta

 Set pasta = CreateObject("Scripting.FileSystemObject")

 NomePasta = ActiveWorkbook.Path & "\" & Range("d6").Text

 If Not pasta.folderexists(NomePasta) Then

 pasta.createfolder (NomePasta)

 End If

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _

    Filename:=ActiveWorkbook.Path & "\" & Range("d6") & "\" & "Relatório Nº " & Range("d2") & ".pdf", _

    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False

   Application.ScreenUpdating = True

End Sub

Link para o comentário
Compartilhar em outros sites

  • 0

Olá marcelo carlos

Na células o ideal e usar a propriedade value (Range("d6").Value)

Teste...

Private Sub CommandButton1_Click()

 Application.ScreenUpdating = False

 Dim caminho As String

 Dim pasta As Object, NomePasta

 Set pasta = CreateObject("Scripting.FileSystemObject")

 NomePasta = ActiveWorkbook.Path & "\" & Range("d6").Value 'alterado

 If Not pasta.folderexists(NomePasta) Then

 pasta.createfolder (NomePasta)

 End If

    If Dir(ActiveWorkbook.Path & "\" & Range("d6").Value & "\" & "Relatório Nº " & Range("d2").Value & ".pdf") = vbNullString Then
            
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=ActiveWorkbook.Path & "\" & Range("d6")
.Value & "\" & "Relatório Nº " & Range("d2").Value & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False
    
    Else
    
        MsgBox "Arquivo já existente"
        
        Exit Sub
        
    End If

   Application.ScreenUpdating = True

End Sub

Se você quiser que o usuário altere a planilha sem fechar o form, deixe a propriedade ShowModal em FALSE.

image.png.6aa0a6bdcebad5e304271637152aab5a.png

Veja se é por ai...

Link para o comentário
Compartilhar em outros sites

  • 0

Boa Tarde Marcio.Rodrigues e a todos

Uma nova demanda surgiu essa semana e estou tendo dificuldade de fazer o código funcionar.Preciso fazer com que as pastas numeradas criadas a partir do preenchimento das células D2 e D4 do formulário("Teste")  sejam criadas dentro da pasta auditoria, ou seja ,serão subpastas da pasta "Auditoria".

Como ficaria o código para isso ocorrer?

 

exemplo.jpg

Link para o comentário
Compartilhar em outros sites

  • 0

Olá marcelo carlos

Altere estas linhas do código e teste:

 NomePasta = ActiveWorkbook.Path & "\Auditoria\" & Range("d6").Value  'alterado

 If Dir(NomePasta & "Relatório Nº " & Range("d2").Value & ".pdf") = vbNullString Then
            
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=NomePasta & "\" & "Relatório Nº " & Range("d2").Value & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=False

Veja se é por ai!!!!

Link para o comentário
Compartilhar em outros sites

  • 0

Boa noite Marcio.Rodrigues

Testei o código.Ele está funcionando.Está salvando as pastas numeradas dentro da pasta auditoria. Porém quando digitamos na célula d2 um número de um arquivo  pdf já existente e rodamos o código o mesmo gera um novo arquivo PDF e suprime o anterior sem mostrar a msgbox. Esse esta sendo o incoveniente agora.

 

Link para o comentário
Compartilhar em outros sites

  • 0

 

Deu certo 

Segue o código.

Obrigado marcio.rodrigues

 

 

Private Sub CommandButton1_Click()

 

Application.ScreenUpdating = False

Dim caminho As String

Dim pasta As Object, NomePasta

Set pasta = CreateObject("Scripting.FileSystemObject")

NomePasta = ActiveWorkbook.Path & "\Auditoria\" & Range("d6").Value

If Not pasta.folderexists(NomePasta) Then

pasta.createfolder (NomePasta)

End If

    If Dir(ActiveWorkbook.Path & "\Auditoria\" & Range("d6").Value & "\" & "Relatório Nº " & Range("d2").Value & ".pdf") = vbNullString Then

           

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _

            Filename:=ActiveWorkbook.Path & "\Auditoria\" & Range("d6").Value & "\" & "Relatório Nº " & Range("d2").Value & ".pdf", _

                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

   

    Else

   

        MsgBox "Arquivo já existente"

       

        Exit Sub

       

    End If

   Application.ScreenUpdating = True

End Sub

 

 

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,4k
×
×
  • Criar Novo...