Boa tarde,
Tenho um código que funciona muito bem para digitalizar um JPG. Código este adaptado de um post deste forum.
Este código abaixo me permite escolher onde o arquivo será salvo e depois copia o link em um campo no formulário ( fiz isso para que o Banco de dados não fique pesado).
Bom, o que eu preciso é digitalizar várias paginas e salvar em pdf o arquivo final.
Então por exemplo: Voce digitaliza a primeira pagina e em seguida vem uma mensagem perguntando se voce quer digitalizar mais alguma e assim vai até o usuário clicar em Não ( no caso quando já tiver digitalizado tudo o que precisava ). Neste momento as paginas são formatadas para PDF.
Meu código é esse:
________________________________________________________________________________________
Public Sub ObterImagem()
Dim LocalArquivo As String
Dim NomeArquivo As FileDialog
Set NomeArquivo = Application.FileDialog(msoFileDialogSaveAs)
On Error Resume Next
NomeArquivo.Title = "Salve o Arquivo como..."
NomeArquivo.InitialFileName = "Meu caminho na Rede onde salvo os arquivos"
NomeArquivo.InitialFileName = ""
If NomeArquivo.Show Then
LocalArquivo = NomeArquivo.SelectedItems(1) & ".jpg"
strSalvarScanner = LocalArquivo
Dim scan As Object
Dim imagem As Object
Set scan = CreateObject("WIA.CommonDialog")
Set imagem = CreateObject("WIA.ImageFile")
Set imagem = scan.ShowAcquireImage()
imagem.SaveFile LocalArquivo
End If
End Sub
Tem um código que achei na internet que parece o caminho, mas não estou conseguindo adaptar. Assim abaixo passarei o código que eu estou estudando e peço que alguem me ajude a chegar no resultado que mencionei acima.
____________________________________________________________________________________________________________
'Requirements:
'Must include reference to Microsoft Windows Image Acquisition 2.0 dll
'Create a table named scantemp. Create ID column as Autonumber. Create 2nd column named Picture with Text as datatype.
'Create a continuous report named rptscan. Set scantemp table as recordsource. Add image control to report and set Picture
'as the control source. Make the image control the size of an 8.5 x 11 sheet so that the whole document appears normally when the
'create textbox set name txt_id for enter PDF files name
'report is exported to pdf.
'For use with a scanner that continually scans documents until the ADF tray is empty unlimit pages.
option Compare Database
Option Explicit
Const WIA_FORMAT_JPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
Public Sub ScanDocs()
Dim intPages As Integer 'number of pages
Dim img As WIA.ImageFile
Dim strPath As String
Dim strFileJPG As String
strPath = CurrentProject.Path 'set path to save files
intPages = 1
On Error GoTo ErrorHandler
'scan
ScanStrat:
Dim DialogScan As New WIA.CommonDialog, dpi As Integer, pp As Integer, l As Integer
dpi = 250
Dim Scanner As WIA.Device
Set Scanner = DialogScan.ShowSelectDevice(WIA.WiaDeviceType.ScannerDeviceType, False, False)
'set properties device
Scanner.Properties("3088").Value = 1 'Automatic Document Feeder
Scanner.Items(1).Properties("6146").Value = 4 'Colour intent
Scanner.Items(1).Properties("6147").Value = dpi 'DPI horizontal
Scanner.Items(1).Properties("6148").Value = dpi 'DPI vertical
Scanner.Items(1).Properties("6149").Value = 0 'x point to start scan
Scanner.Items(1).Properties("6150").Value = 0 'y point to start scan
Scanner.Items(1).Properties("6151").Value = 8.27 * dpi 'Horizontal extent
Scanner.Items(1).Properties("6152").Value = 11.7 * dpi 'Vertical extent for A4
Scanner.Items(1).Properties("6154").Value = 80 'brightness
' Scanner.Items(1).Properties("6155").Value = 30 'contrast
'Start Scan if err number -2145320957 Scan document finish
Do While Err.Number <> -2145320957 'error number is ADF status don't feed document
Set img = Scanner.Items(1).Transfer(WIA_FORMAT_JPEG)
strFileJPG = strPath & "\FileScan\temp\" & CStr(intPages) & ".jpg"
img.SaveFile (strFileJPG) 'save files .jpg in temp folder
DoCmd.SetWarnings False
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG & "')" 'insert picture temp to table scan temp
intPages = intPages + 1 'add number pages
Loop
'after finish scan start convert to pdf
StartPDFConversion:
Dim strFilePDF As String '
Dim RptName As String
strFilePDF = CurrentProject.Path & "\FileScan\" & txt_id.Value & ".pdf" 'pdf file name by textbox
RptName = "rptScan" 'report picture file for export to PDF
DoCmd.OpenReport RptName, acViewDesign, , , acHidden
DoCmd.Close acReport, RptName, acSaveYes
DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFilePDF
DoCmd.RunSQL "delete from scantemp" 'delete all data from table scantemp
DeleteTemp:
'delete files temp (JPG)
Dim i As Integer
Dim filesname As String
i = 1
'loop pages number (intpages)
Do While i < intPages
filesname = CurrentProject.Path & "\FileScan\temp\" & i & ".jpg"
If Dir(filesname) <> "" Then
'SetAttr filesname, vbNormal
Kill filesname
Else
Exit Do
End If
i = i + 1
Loop
MsgBox ("done")
Exit Sub
ErrorHandler:
Select Case Err.Number
Case -2145320957
If intPages = 1 Then
MsgBox ("not found document to scan")
Exit Sub
Else
GoTo StartPDFConversion
End If
End Select
MsgBox "Error" & ": " & Err.Number & vbCrLf & "Description: " _
& Err.Description, vbExclamation, Me.Name & ".ScanDocs"
End Sub
__________________________________________________________________________________________________________________
Quem puder me ajudar nisso e quiser falar comigo podemos conversar via skype ou algo assim ou até por aqui mesmo.
Creio que ao conseguir finalizar este código estaremos ajudando muitas pessoas neste forum por se tratar de um código bem interessante.
Fico no aguardo e desde já agradeço.
Att,
Tenho um código que funciona muito bem para digitalizar um JPG. Código este adaptado de um post deste forum.
Este código abaixo me permite escolher onde o arquivo será salvo e depois copia o link em um campo no formulário ( fiz isso para que o Banco de dados não fique pesado).
Bom, o que eu preciso é digitalizar várias paginas e salvar em pdf o arquivo final.
Então por exemplo: Voce digitaliza a primeira pagina e em seguida vem uma mensagem perguntando se voce quer digitalizar mais alguma e assim vai até o usuário clicar em Não ( no caso quando já tiver digitalizado tudo o que precisava ). Neste momento as paginas são formatadas para PDF.
Meu código é esse:
________________________________________________________________________________________
Public Sub ObterImagem()
Dim LocalArquivo As String
Dim NomeArquivo As FileDialog
Set NomeArquivo = Application.FileDialog(msoFileDialogSaveAs)
On Error Resume Next
NomeArquivo.Title = "Salve o Arquivo como..."
NomeArquivo.InitialFileName = "Meu caminho na Rede onde salvo os arquivos"
NomeArquivo.InitialFileName = ""
If NomeArquivo.Show Then
LocalArquivo = NomeArquivo.SelectedItems(1) & ".jpg"
strSalvarScanner = LocalArquivo
Dim scan As Object
Dim imagem As Object
Set scan = CreateObject("WIA.CommonDialog")
Set imagem = CreateObject("WIA.ImageFile")
Set imagem = scan.ShowAcquireImage()
imagem.SaveFile LocalArquivo
End If
End Sub
Tem um código que achei na internet que parece o caminho, mas não estou conseguindo adaptar. Assim abaixo passarei o código que eu estou estudando e peço que alguem me ajude a chegar no resultado que mencionei acima.
____________________________________________________________________________________________________________
'Requirements:
'Must include reference to Microsoft Windows Image Acquisition 2.0 dll
'Create a table named scantemp. Create ID column as Autonumber. Create 2nd column named Picture with Text as datatype.
'Create a continuous report named rptscan. Set scantemp table as recordsource. Add image control to report and set Picture
'as the control source. Make the image control the size of an 8.5 x 11 sheet so that the whole document appears normally when the
'create textbox set name txt_id for enter PDF files name
'report is exported to pdf.
'For use with a scanner that continually scans documents until the ADF tray is empty unlimit pages.
option Compare Database
Option Explicit
Const WIA_FORMAT_JPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
Public Sub ScanDocs()
Dim intPages As Integer 'number of pages
Dim img As WIA.ImageFile
Dim strPath As String
Dim strFileJPG As String
strPath = CurrentProject.Path 'set path to save files
intPages = 1
On Error GoTo ErrorHandler
'scan
ScanStrat:
Dim DialogScan As New WIA.CommonDialog, dpi As Integer, pp As Integer, l As Integer
dpi = 250
Dim Scanner As WIA.Device
Set Scanner = DialogScan.ShowSelectDevice(WIA.WiaDeviceType.ScannerDeviceType, False, False)
'set properties device
Scanner.Properties("3088").Value = 1 'Automatic Document Feeder
Scanner.Items(1).Properties("6146").Value = 4 'Colour intent
Scanner.Items(1).Properties("6147").Value = dpi 'DPI horizontal
Scanner.Items(1).Properties("6148").Value = dpi 'DPI vertical
Scanner.Items(1).Properties("6149").Value = 0 'x point to start scan
Scanner.Items(1).Properties("6150").Value = 0 'y point to start scan
Scanner.Items(1).Properties("6151").Value = 8.27 * dpi 'Horizontal extent
Scanner.Items(1).Properties("6152").Value = 11.7 * dpi 'Vertical extent for A4
Scanner.Items(1).Properties("6154").Value = 80 'brightness
' Scanner.Items(1).Properties("6155").Value = 30 'contrast
'Start Scan if err number -2145320957 Scan document finish
Do While Err.Number <> -2145320957 'error number is ADF status don't feed document
Set img = Scanner.Items(1).Transfer(WIA_FORMAT_JPEG)
strFileJPG = strPath & "\FileScan\temp\" & CStr(intPages) & ".jpg"
img.SaveFile (strFileJPG) 'save files .jpg in temp folder
DoCmd.SetWarnings False
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG & "')" 'insert picture temp to table scan temp
intPages = intPages + 1 'add number pages
Loop
'after finish scan start convert to pdf
StartPDFConversion:
Dim strFilePDF As String '
Dim RptName As String
strFilePDF = CurrentProject.Path & "\FileScan\" & txt_id.Value & ".pdf" 'pdf file name by textbox
RptName = "rptScan" 'report picture file for export to PDF
DoCmd.OpenReport RptName, acViewDesign, , , acHidden
DoCmd.Close acReport, RptName, acSaveYes
DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFilePDF
DoCmd.RunSQL "delete from scantemp" 'delete all data from table scantemp
DeleteTemp:
'delete files temp (JPG)
Dim i As Integer
Dim filesname As String
i = 1
'loop pages number (intpages)
Do While i < intPages
filesname = CurrentProject.Path & "\FileScan\temp\" & i & ".jpg"
If Dir(filesname) <> "" Then
'SetAttr filesname, vbNormal
Kill filesname
Else
Exit Do
End If
i = i + 1
Loop
MsgBox ("done")
Exit Sub
ErrorHandler:
Select Case Err.Number
Case -2145320957
If intPages = 1 Then
MsgBox ("not found document to scan")
Exit Sub
Else
GoTo StartPDFConversion
End If
End Select
MsgBox "Error" & ": " & Err.Number & vbCrLf & "Description: " _
& Err.Description, vbExclamation, Me.Name & ".ScanDocs"
End Sub
__________________________________________________________________________________________________________________
Quem puder me ajudar nisso e quiser falar comigo podemos conversar via skype ou algo assim ou até por aqui mesmo.
Creio que ao conseguir finalizar este código estaremos ajudando muitas pessoas neste forum por se tratar de um código bem interessante.
Fico no aguardo e desde já agradeço.
Att,
Última edição por rpfspawn em 8/5/2017, 20:12, editado 1 vez(es)