MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Impressão de 2 ou mais vias

    Compartilhe
    avatar
    toyebom
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 873
    Registrado : 18/07/2012

    Impressão de 2 ou mais vias

    Mensagem  toyebom em Ter 18 Mar 2014, 01:23

    Tive necessidade de imprimir relatórios em 2 ou mais vias no qual me informasse qual o original, duplicado e triplicado
    Após vária pesquisa encontrei no forum um código

    [Você precisa estar registrado e conectado para ver este link.]

    Como era quase o que queria adaptei e resolvi fazer uma bd de exemplo para quem necessitar.
    Não coloquei o codigo todo porque o meu alem de imprimir cria um pdf que guarda numa pasta junto á bd a qual caso não exista cria, mas também forneço esse codigo para consulta

    o código que utilizo na minha bd é:

    Código:
    Private Sub Comando817_Click()
    Dim strArquivo As String
    Dim strLocal As String
    Dim fso As Object
    Dim strDocumento As String
    Dim bytVias, bytLoop As Byte

      bytVias = InputBox("Quantas vias deseja imprimir? ", "Impressão", 1)
      If bytVias <> "" And bytVias <= 6 Then
        For bytLoop = 1 To bytVias
          If bytLoop = 1 Then MsrVersao = "ORIGINAL"
          If bytLoop = 2 Then MsrVersao = "DUPLICADO"
          If bytLoop = 3 Then MsrVersao = "TRIPLICADO"
          If bytLoop = 4 Then MsrVersao = "QUADRUPLICADO"
          If bytLoop = 5 Then MsrVersao = "QUINTUPLICADO"
          If bytLoop = 6 Then MsrVersao = "SEXTUPLICADO"
    DoCmd.Save
    DoCmd.OpenReport "Oficio Remessa Autos", acViewPreview, , "[CódigoDoProduto] = " & [CódigoDoProduto]
    DoCmd.Maximize
    strLocal = CurrentProject.Path & "\Inquéritos\" & Replace(Replace(Me!CodBarra, "/", "_"), ".", "-") & "\"
    strDocumento = "Oficio Remessa Autos"
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.folderexists(strLocal) Then ' verifica se ja existe a pasta e subpasta
    DoCmd.OutputTo acOutputReport, strDocumento, acFormatPDF, strLocal & "Oficio Remessa Autos" & " " & Replace(Me!CodBarra, "/", "_") & " _ " & Me![CódigoDoProduto] & ".pdf", False
    Else
    MkDir strLocal ' se nao existir cria
    DoCmd.OutputTo acOutputReport, strDocumento, acFormatPDF, strLocal & "Oficio Remessa Autos" & " " & Replace(Me!CodBarra, "/", "_") & " _ " & Me![CódigoDoProduto] & ".pdf", False
    DoCmd.Close
    End If
    DoCmd.OpenReport "Oficio Remessa Autos", acViewPreview, , "[CódigoDoProduto] = " & [CódigoDoProduto]
    DoCmd.Maximize
    strLocal = CurrentProject.Path & "\Oficios\Oficios Expedidos\" & "\"
    strDocumento = "Oficio Remessa Autos"
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.folderexists(strLocal) Then ' verifica se ja existe a pasta e subpasta
    DoCmd.OutputTo acOutputReport, strDocumento, acFormatPDF, strLocal & Replace(Me!oficioconcluido, "/", "_") & " _ " & Me![CódigoDoProduto] & ".pdf", False
    Else
    MkDir strLocal ' se nao existir cria
    DoCmd.OutputTo acOutputReport, strDocumento, acFormatPDF, strLocal & Replace(Me!oficioconcluido, "/", "_") & " _ " & Me![CódigoDoProduto] & ".pdf", False
    DoCmd.Close
    End If

        DoCmd.PrintOut
    DoCmd.Close
    Next
    End If
    Exit_Comando817_Click:
        Exit Sub

    Err_Comando817_Click:
        MsgBox Err.Description
        Resume Exit_Comando817_Click
    End Sub

    Utilizo ainda este para pasta já criada que me pergunta se quero criar pdf:

    Código:
    On Error GoTo Err_Comando570_Click
    Dim strArquivo As String
    Dim strLocal As String
    Dim bytVias, bytLoop As Byte

      bytVias = InputBox("Quantas vias deseja imprimir? ", "Impressão", 1)
      If bytVias <> "" And bytVias <= 6 Then
        For bytLoop = 1 To bytVias
          If bytLoop = 1 Then MsrVersao = "ORIGINAL"
          If bytLoop = 2 Then MsrVersao = "DUPLICADO"
          If bytLoop = 3 Then MsrVersao = "TRIPLICADO"
          If bytLoop = 4 Then MsrVersao = "QUADRUPLICADO"
          If bytLoop = 5 Then MsrVersao = "QUINTUPLICADO"
          If bytLoop = 6 Then MsrVersao = "SEXTUPLICADO"
    DoCmd.Save
    DoCmd.OpenReport "Oficio Normal1", acViewPreview, , "[001] = " & [001]
    DoCmd.Maximize
    strArquivo = Replace(Me!cam7, "/", "_") & " _ " & Me![001] & ".pdf"
    strLocal = CurrentProject.Path & "\Oficios\Oficios Expedidos\" & strArquivo
    DoCmd.OutputTo acOutputReport, "Oficio Normal1", acFormatPDF, strLocal
        DoCmd.PrintOut
    DoCmd.Close
    Next
    End If
    Exit_Comando570_Click:
        Exit Sub

    Err_Comando570_Click:
        MsgBox Err.Description
        Resume Exit_Comando570_Click
        
    End Sub

    A bd de exemplo é esta, espero poder ajudar alguém:
    Anexos
    2 Vias.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (46 Kb) Baixado 155 vez(es)


    .................................................................................
    Gente Simples, fazendo coisas pequenas, em lugares pouco importantes, consegue mudanças extraordinárias.

      Data/hora atual: Qua 18 Out 2017, 15:33