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 é:
Utilizo ainda este para pasta já criada que me pergunta se quero criar pdf:
A bd de exemplo é esta, espero poder ajudar alguém:
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: