Excel macro salvar pdf - excel

[ROBAOCIS]

Boa tardee, estou com a macro a seguir que vou utilizar p salvar arquivos em pdf no excel e preciso acrescentar mais duas funçoes. Preciso de uma linha para especificar o local que esse arquivo será salvo, e que também seja salvo em formato Excel nesse mesmo direetório. Como consigo isso plssss

 

Sub SalvarPDF()

Dim MyDate
Dim Clinte As String
Dim Separador As String
Dim Veículo As String

Cliente = Range("A7").Value 'ou onde estiver o nome do cliente.
Separador = " - "
Veículu = Range("D8").Value
          
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Cliente + Separador + Arquivo, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True

ActiveWorkbook.Close

 

End Sub

[Victor Comparini]

Olá!

 

Tente o código abaixo:

 

Sub SalvarArquivo()
'
' Salvar em PDF e XLSM
'
Dim MyDate
Dim Clinte As String
Dim Separador As String
Dim Veículo As String
Dim local_pasta As String
'
    Cliente = Range("A7").Value 'ou onde estiver o nome do cliente.
    Separador = " - "
    Veículu = Range("D8").Value
    local_pasta = "C:\Users\nome de usuário\Desktop\" 'Local do arquivo
    
    ChDir "C:\Users\nome de usuário\Desktop"
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        local_pasta + Cliente + Separador + Arquivo, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
    ActiveWorkbook.SaveAs Filename:=local_pasta + Cliente + Separador + Arquivo, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        
    ActiveWorkbook.Close
End Sub

 

[ROBAOCIS]

@Vics  Bom dia, foi apresentado esse erro:

adicionado 25 minutos depois

23 minutos atrás, ROBAOCIS disse:

@Vics  Bom dia, foi apresentado esse erro:

 

-Atualização-

Consegui fazer desta forma:

 

Sub SalvarArquivo()
'
' Salvar em PDF e XLSM
'
Dim MyDate
Dim Clinte As String
Dim Separador As String
Dim Veículo As String
Dim Placa As String
'
    Cliente = Range("A7").Value 'ou onde estiver o nome do cliente.
    Separador = " - "
    Veiculo = Range("D8").Value
    Placa = Range("D9").Value
    
    ChDir "C:\Users\USUARIO\Google Drive\ORÇAMENTOS"
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Cliente + Separador + Veiculo + Separador + Placa, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
    ActiveWorkbook.SaveAs Filename:=Cliente + Separador + Veiculo + Separador + Placa, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        
    ActiveWorkbook.Close
End Sub

 

 

Porém eu quero que o formato fique em xlsx mesmo, tem como você alterar pra mim?

[Victor Comparini]

 

@ROBAOCIS você precisa mudar a variável local_pasta desta forma ele não está salvando porque não está encontrando o caminho especificado.

 

[ROBAOCIS]

4 horas atrás, Vics disse:

 

@ROBAOCIS você precisa mudar a variável local_pasta desta forma ele não está salvando porque não está encontrando o caminho especificado.

 

Oi, boa tarde. Tudo está funcionando perfeitamente, quase perfeitamente da seguinte forma, segue:

 

Sub SalvarArquivo()
'
' Salvar em PDF e XLSM
'
Dim MyDate
Dim Clinte As String
Dim Separador As String
Dim Veículo As String
Dim Placa As String
Dim Data As String
'
    Cliente = Range("A7").Value 'ou onde estiver o nome do cliente.
    Separador = " - "
    Veiculo = Range("D8").Value
    Placa = Range("D9").Value
    Data = Range("D7").Text
    
    
    ChDir "C:\Users\USUARIO\Google Drive\ORÇAMENTOS"
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Cliente + Separador + Veiculo + Separador + Placa + Separador + Data, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
    ActiveWorkbook.SaveAs Filename:=Cliente + Separador + Veiculo + Separador + Placa + Separador + Data, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        
    ActiveWorkbook.Close
End Sub

 

Porém, surgiu um novo problema. Eu adicionei um botão que ativasse a macro com o nome salvar orçamento à planilha. Porém, a pasta que eu direcionei, é sincronizada, do google drive, pois preciso que esses orçamentos estejam em quatro computadores diferentes. Dá certo, porém se eu faço um documento em um computador, e edito em outro, o botão salva o arquivo no caminho do primeiro endereçado. Ex:

 

Enfim, quero saber se existe uma forma de adicionar uma condicional que identifique qual computador está sendo utilizado, para direcionar ao caminho certo. Ou alguma forma de ficar tentando um dos quatro caminhos até salvar. 

 

Os diretórios são:

C:\Users\PC\Google Drive\ORÇAMENTOS
C:\Users\4X4\Google Drive\ORÇAMENTOS

C:\Users\USUARIO\Google Drive\ORÇAMENTOS

 

Obs: Se houver uma forma de mudar o nome da pasta do usuário creio que também dê certo, mas tentei renomear e não consegui.

 

 

[Victor Comparini]

16 minutos atrás, ROBAOCIS disse:

Os diretórios são:

C:\Users\PC\Google Drive\ORÇAMENTOS
C:\Users\4X4\Google Drive\ORÇAMENTOS

C:\Users\USUARIO\Google Drive\ORÇAMENTOS

 

Obs: Se houver uma forma de mudar o nome da pasta do usuário creio que também dê certo, mas tentei renomear e não consegui.

 

Olá,

Desculpe, eu devia ter pensado nisso antes.

 

no começo do código, você acrescenta a variável

Dim user

 

depois atribui

user = Environ("USERNAME") 'buscar nome de usuário do computador.

 

e coloca o loca da pasta.

localPasta = "C:\Users\" & user & "\Desktop\"

ChDir "C:\Users\" & user & "\Desktop"

Veja se funcionou.

[ROBAOCIS]

1 hora atrás, Vics disse:

 

Olá,

Desculpe, eu devia ter pensado nisso antes.

 

no começo do código, você acrescenta a variável

Dim user

 

depois atribui

user = Environ("USERNAME") 'buscar nome de usuário do computador.

 

e coloca o loca da pasta.

localPasta = "C:\Users\" & user & "\Desktop\"

ChDir "C:\Users\" & user & "\Desktop"

Veja se funcionou.

Cara você é simplesmente um gênio. Tá funcionando perfeito agora. Mais tarde posto o código pra ademais usuários que precisarem.

Muito obrigado mesmo. Eu também curto o Excel mas  não sou fanático e não sei nada sobre "programar no Excel", fui só mesclando as coisas que encontrava e que você me disse e deu certo. Muito grato, valeu.

[Victor Comparini]

Em 01/02/2020 às 15:06, ROBAOCIS disse:

Cara você é simplesmente um gênio. Tá funcionando perfeito agora. Mais tarde posto o código pra ademais usuários que precisarem.

Muito obrigado mesmo. Eu também curto o Excel mas  não sou fanático e não sei nada sobre "programar no Excel", fui só mesclando as coisas que encontrava e que você me disse e deu certo. Muito grato, valeu.

 

kkk. Obrigado pelo elogio. Na verdade eu não sou gênio, tem coisas que eu erro feio kk.
Comecei acompanha Excel depois que comecei a trabalhar na empresa que estou hoje e coincidentemente estou sendo desligado hoje. Meu Ex-Chefe que foi desligado um tempo atrás, ele sim era o verdadeiro gênio e mestre, o melhor que conheci pessoalmente, foi ele que me inspirou a fazer alguns cursos pagos, video-aulas... muita coisa aprendi pesquisando também e ajudar os outros aqui no forum tem me ajudado bastante. É bom ter reconhecimento, obrigado mesmo.

[ROBAOCIS]

8 horas atrás, Vics disse:

 

kkk. Obrigado pelo elogio. Na verdade eu não sou gênio, tem coisas que eu erro feio kk.
Comecei acompanha Excel depois que comecei a trabalhar na empresa que estou hoje e coincidentemente estou sendo desligado hoje. Meu Ex-Chefe que foi desligado um tempo atrás, ele sim era o verdadeiro gênio e mestre, o melhor que conheci pessoalmente, foi ele que me inspirou a fazer alguns cursos pagos, video-aulas... muita coisa aprendi pesquisando também e ajudar os outros aqui no forum tem me ajudado bastante. É bom ter reconhecimento, obrigado mesmo.

Acho que gênios erram também haha.. Sinto muito por você . Desculpa perguntar, mas você trabalhava em que tipo de empresa mesmo?

 

Enfim, segue a macro funcionando plenamente:

 

Citação

Sub SalvarArquivo()
'
' Salvar em PDF e XLSM
'
Dim MyDate
Dim Clinte As String
Dim Separador As String
Dim Veículo As String
Dim Placa As String
Dim Data As String
Dim user As String

'
    Cliente = Range("A7").Value 'ou onde estiver o nome do cliente.
    Separador = " - "
    Veiculo = Range("D8").Value
    Placa = Range("D9").Value
    Data = Range("D7").Text
    user = Environ("USERNAME") 'buscar nome de usuário do computador.

    
    ChDir "C:\Users\" & user & "\Google Drive\ORÇAMENTOS"
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Cliente + Separador + Veiculo + Separador + Placa + Separador + Data, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
    ActiveWorkbook.SaveAs Filename:=Cliente + Separador + Veiculo + Separador + Placa + Separador + Data, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        
    ActiveWorkbook.Close
End Sub

Algumas coisas que você falou eu nem utilizei, então se você puder revisar, ver se não tem algum erro fico grato também.. 

[Victor Comparini]

@ROBAOCIS

 

Testei o código aqui e funcionou perfeitamente, além de que ficou simples e da pra entender super bem. Parabéns, ficou muito bom!

 

Você poderia marcar esse tópico como resolvido, na minha assinatura tem um tutorial de como fazer.

 

Quanto a pergunta a respeito da minha empresa, responderei por mensagem privada pra não mudar o assunto do tópico.