MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

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


    Impressão de 2 ou mais vias

    toyebom
    toyebom
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

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

    Impressão de 2 ou mais vias Empty Impressão de 2 ou mais vias

    Mensagem  toyebom 18/3/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

    http://maximoaccess.forumeiros.com/t5038-resolvidoimprimir-relatorio-quatro-vias?highlight=2+vias

    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:


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

      Data/hora atual: 22/11/2024, 01:32