Controlar janela "Salvar como"

Question

Olá, pessoal. Sou iniciante em VBA e gostaria da ajuda de vocês para um ponto de dúvida. Sempre estou pesquisando sobre o assunto e gosto muito desse fórum.

Criei uma macro para salvar comprovantes de pagamento do sistema SAP para *.pdf e o código processa tudo de forma correta até aparecer a janela de salvar como que é do windows e não do SAP. A partir daí, a macro segue o loop e vai gerando as janelas para salvar e eu não consigo criar algum código para colocar o nome do arquivo na janela "salvar como" e selecionar a pasta onde quero salvar.

Pesquisei em muitos lugares e o máximo que consegui foi a informação de que é um código API, mas não sei programar isso ainda.

Basicamente, eu preciso que, quando aparecer a janela "salvar como", o sistema faça o seguinte:

- selecionar pasta onde o arquivo em pdf será salvo:
"C:\Users\" & User & "\Desktop\HOLERITES\" & RE & "_" & NOME
- inseri nome do arquivo:
"MES.ANO"

Vocês poderiam me ajudar?

Answer 1

Oi, tem duas possibilidade.

1° SALVAR DIRETO EM FORMATO PDF

Sub PDFActiveSheet_AutomaticoDATAeNOME()
'Macro SALVAR PDF com captação de nome e data automatico

Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo ErrHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd.mm.yyyy\_hh.mm")

'Pegar diretório atual, se estiver salvo
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'Trocar espeços no nome
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'Criação de nome padrão
strFile = strName & "_" & strTime & ".pdf"

'F5 é o Range que determina o nome automaticamente do arquivo e yyyy.mm.dd é o tipo de formatação da data
strPathFile = strPath & Format(Now, "yyyy.mm.dd") & Range("F5") & ".pdf"

'Escolher diretório
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Selecione diretório e nome do arquivo")

'Gerar pdf no diretório escolhido
If myFile <> "Falso" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
        
    'Mensagem de confirmação
    MsgBox "PDF gerado com sucesso: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
ErrHandler:
    MsgBox "Não foi possível gerar o PDF", vbCritical
    Resume exitHandler
End Sub

2° UTILIZANDO A JANELA SALVAR COMO E ALTERAR MANUALMENTE A O FORMATO DO ARQUIVO

Sub Salvar_Como_AutomaticoDATAeNOME()
'Macro Salvar Como com captação de nome e inclusão de data automatico

If newName = "" Then

'F5 é o Range que determina o nome automaticamente do arquivo
str1 = Range("F5")

Else

str1 = newName

End If

'Formatação de data
str1 = Format(Now, "yyyy.mm.dd") & str1

ck = Application.Dialogs(xlDialogSaveAs).Show(str1)

If ck = True Then

newName = ActiveWorkbook.Name

End If

End Sub

Answer 2

Oi, tem duas possibilidade.

1° SALVAR DIRETO EM FORMATO PDF

Sub PDFActiveSheet_AutomaticoDATAeNOME()
'Macro SALVAR PDF com captação de nome e data automatico

Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo ErrHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd.mm.yyyy\_hh.mm")

'Pegar diretório atual, se estiver salvo
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'Trocar espeços no nome
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'Criação de nome padrão
strFile = strName & "_" & strTime & ".pdf"

'F5 é o Range que determina o nome automaticamente do arquivo e yyyy.mm.dd é o tipo de formatação da data
strPathFile = strPath & Format(Now, "yyyy.mm.dd") & Range("F5") & ".pdf"

'Escolher diretório
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Selecione diretório e nome do arquivo")

'Gerar pdf no diretório escolhido
If myFile <> "Falso" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
        
    'Mensagem de confirmação
    MsgBox "PDF gerado com sucesso: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
ErrHandler:
    MsgBox "Não foi possível gerar o PDF", vbCritical
    Resume exitHandler
End Sub

2° UTILIZANDO A JANELA SALVAR COMO E ALTERAR MANUALMENTE A O FORMATO DO ARQUIVO

Sub Salvar_Como_AutomaticoDATAeNOME()
'Macro Salvar Como com captação de nome e inclusão de data automatico

If newName = "" Then

'F5 é o Range que determina o nome automaticamente do arquivo
str1 = Range("F5")

Else

str1 = newName

End If

'Formatação de data
str1 = Format(Now, "yyyy.mm.dd") & str1

ck = Application.Dialogs(xlDialogSaveAs).Show(str1)

If ck = True Then

newName = ActiveWorkbook.Name

End If

End Sub

Barbara Bettanin, obrigado pela resposta, mas não atende minha necessidade.

Minha intenção não é salvar uma planilha direto do excel, mas salvar um documento gerado de outro sistema. Eu uso o SAP na minha empresa e, às vezes, preciso emitir vários holerites de pagamentos e o sistema não oferece um recurso de impressão em lote nessa transação. Então, criei essa macro, mas não consigo programar para controlar a janela 'salvar como' quando ela aparece. Eu seleciono a opção no sistema para salvar em *pdf, clico em imprimir e, depois, aparece a janela 'salvar como'. Eu preciso programar para inserir o nome do documento e escolher a pasta para salvar. Será que não precisa usar um código API? A minha macro ficou assim:

Sub Holerite_massa()

LINHA = Range("A1000000").End(xlUp).Row

If WorksheetFunction.CountA(Range("A2:A" & LINHA + 1)) = 0 Then
    MsgBox "Preencha dados para o processamento", vbQuestion + vbOKOnly
Exit Sub
End If

If WorksheetFunction.CountBlank(Range("E2:E" & LINHA)) = 0 Then
    MsgBox "Analisar coluna " & Range("E1").Value, vbExclamation + vbOKOnly
Exit Sub
End If

If MsgBox("Deseja realmente iniciar o processamento?", vbExclamation + vbYesNo + vbDefaultButton2, "ATENÇÃO") = vbNo Then
Exit Sub
End If


Dim RE, NOME, MES, ANO

For I = 2 To Range("A1000000").End(xlUp).Row

If Range("E" & I).Value = "" Then

RE = Range("A" & I).Value
NOME = Left(Range("B" & I).Value, WorksheetFunction.Find(" ", Range("B" & I).Value) - 1)
MES = Month(Range("C" & I).Value)
ANO = Year(Range("C" & I).Value)


On Error Resume Next

If Not IsObject(App) Then
   Set SapGuiAuto = GetObject("SAPGUI")
   Set App = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(Connection) Then
   Set Connection = App.Children(0)
End If
If Not IsObject(session) Then
   Set session = Connection.Children(0)
End If
If IsObject(WScript) Then
   WScript.ConnectObject session, "on"
   WScript.ConnectObject App, "on"
End If


If Err <> 0 Then
MsgBox "SAP NÃO ESTÁ LOGADO!", vbCritical, "CONTROLE DE DADOS"
Exit Sub
End If

On Error GoTo 0


Range("A" & I).Select

'Criar pasta para salvar holerite

User = Environ("USERNAME")

On Error Resume Next
If Len(Dir("C:\Users\" & User & "\Desktop\HOLERITES", vbDirectory)) = 0 Then
    MkDir "C:\Users\" & User & "\Desktop\HOLERITES"
End If
If Len(Dir("C:\Users\" & User & "\Desktop\HOLERITES\" & RE & "_" & NOME, vbDirectory)) = 0 Then
    MkDir "C:\Users\" & User & "\Desktop\HOLERITES\" & RE & "_" & NOME
End If

session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").Text = "/NZRH_PR10"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/tbar[1]/btn[17]").press
session.findById("wnd[1]/usr/txtV-LOW").Text = "HOLERITE_ST"
session.findById("wnd[1]/usr/txtENAME-LOW").Text = "STEINA5"
session.findById("wnd[1]/tbar[0]/btn[8]").press

Do
    session.findById("wnd[0]/usr/txtPNPPABRP").Text = MES
    session.findById("wnd[0]/usr/txtPNPPABRJ").Text = ANO
    session.findById("wnd[0]/usr/ctxtPNPPERNR-LOW").Text = RE
    session.findById("wnd[0]/tbar[1]/btn[8]").press
    session.findById("wnd[1]/usr/ctxtITCPP-TDDEST").Text = "LOCL"
    session.findById("wnd[1]").sendVKey 0
    session.findById("wnd[1]/usr/cmbITCPP-RQPOSNAME").Key = "Microsoft Print to PDF"
    session.findById("wnd[1]/usr/txtITCPP-TDPAGESLCT").Text = "1"
    session.findById("wnd[1]/usr/chkITCPP-TDIMMED").Selected = True
    session.findById("wnd[1]/usr/chkITCPP-TDNEWID").Selected = False
    session.findById("wnd[1]/tbar[0]/btn[86]").press

    Next_Date = DateAdd("m", 1, DateSerial(ANO, MES, 1))

    MES = Month(Next_Date)
    ANO = Year(Next_Date)

   Aqui a janela salvar como aparece.

  'Código para salvar na pasta MkDir "C:\Users\" & User & "\Desktop\HOLERITES\" & RE & "_" & NOME
  'Nome do arquivo deve ser "MES.ANO"

Loop While Next_Date <= Range("D" & I).Value


Range("E" & I).Value = Now
ActiveWorkbook.Save

End If
Next

session.findById("wnd[0]/tbar[0]/btn[15]").press
Range("A1").Select
MsgBox "DADOS PROCESSADOS COM SUCESSO!", vbInformation, "CONTROLE DE DADOS"

End Sub