none
Controlar janela "Salvar como" RRS feed

  • Pergunta

  • 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?
    segunda-feira, 17 de agosto de 2020 03:28

Todas as Respostas

  • 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
    
    


    segunda-feira, 24 de agosto de 2020 17:34
  • 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


    domingo, 6 de setembro de 2020 00:52