marcelo carlos

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

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.

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?

Boa noite a todos Peço ajuda para quem puder me socorrer com o seguinte problema:necessito fazer meu código copiar dados de uma célula que está mesclada e formatada com bordas em negrito(código 1)do meu formulário e colar esses dados em outra célula de outra planilha com bordas padrão (código 2).Não estou conseguindo colar somente os dados da célula sem a mescla. (1)With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin (2) With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThick End With

Boa noite Marcio.Rodrigues Código testado.Funcionou corretamente era isso mesmo que o código precisava fazer.Obrigado pela ajuda.

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

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.