A7MD M7MD

أستاذ @jjafferr الله يصلح حالك يارب ويجزيك خير وربى انا شوفت كل موضوعات المسح الضوئى من البحث قبل ما اكتب الموضوع للعلم حاولت تعديل الكود هذا الكود الاصلى Public Sub ScanDocs() Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}" Dim strFileName As String Dim Dialog1 As New WIA.CommonDialog, DPI As Integer, PP As Integer, l As Integer Dim Scanner As WIA.Device Dim img As WIA.ImageFile Dim intPages As Integer Dim strFileJPG As String Dim i As Integer Dim blnContScan As Boolean Dim ContScan As String 'msgbox to chk if more pages are to be scanned Dim PdfOverwrite As String 'msgbox to confirm pdf file overwite Dim FSO As New FileSystemObject Dim strFilePDF As String Dim RptName As String Dim strProcName As String strProcName = "ScanDocs" 'On Error GoTo Handle_Err 'empty the scantemp table DoCmd.SetWarnings False DoCmd.RunSQL "delete from scantemp" DoCmd.SetWarnings True strFileName = strDocType 'create a temp folder if it does not exists CreateTempFolder 'if a temp folder is present, delete all files from it DeleteFiles 'Code for scanning 'Must include reference to Microsoft Windows Image Acquisition 2.0 dll blnContScan = True intPages = 0 Do While blnContScan = True DPI = 200 PP = 1 'No of pages 'XXXXXXXXXXXXXXXXXX Set Scanner = Dialog1.ShowSelectDevice(WIA.WiaDeviceType.ScannerDeviceType, True, False) With Scanner.Items(1) .Properties("6146").Value = 1 'Colour intent (1 for color, 2 for grayscale, 4 for b & w) .Properties("6147").Value = DPI 'DPI horizontal .Properties("6148").Value = DPI 'DPI vertical .Properties("6149").Value = 0 'x point to start scan .Properties("6150").Value = 0 'y point to start scan .Properties("6151").Value = 8.27 * DPI 'Horizontal extent .Properties("6152").Value = 11.69 * DPI 'Vertical extent for letter End With Set img = Dialog1.ShowTransfer(Scanner.Items(1), wiaFormatJPEG, True) 'Set img = Scanner.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG) intPages = intPages + 1 strFileJPG = strTempFolder & "\" & strFileName & Trim(Str(intPages)) & ".jpg" ' If FSO.FileExists(strFileJPG) Then ' FSO.DeleteFile (strFileJPG) ' End If ' Set FSO = Nothing img.SaveFile (strFileJPG) DoCmd.SetWarnings False DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG & "')" DoCmd.SetWarnings True Set Scanner = Nothing Set img = Nothing strFileJPG = "" 'Prompt user if there are additional pages to scan ContScan = MsgBox("Scan another page?", vbQuestion + vbYesNo, "Continue...?") If ContScan = vbNo Then blnContScan = False End If Loop GoTo StartPDFConversion StartPDFConversion: strFilePDF = strTempFolder & "\" & strFileName & ".pdf" If FSO.FileExists(strFilePDF) Then FSO.DeleteFile (strFilePDF) End If Set FSO = Nothing 'Now let's run an Access report called rptScan and output it to a PDF file on the network 'rptScan is an Access report whose recordsource is the scantemp table RptName = "rptScan" DoCmd.OpenReport RptName, acViewReport, , , acHidden DoCmd.Close acReport, RptName, acSaveYes DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFilePDF CustDocPath = strFilePDF strFilePDF = "" Handle_Exit: Exit Sub Handle_Err: Select Case err.Description Case "The user requested a scan and there are no documents left in the document feeder." MsgBox "Please insert paper into the scanner.", vbCritical, "Warning" Resume Case "ID Not Found." MsgBox "Please check that your scanner is properly connected and powered on and try again later.", vbCritical, "Warning" Resume Handle_Exit Case "No such interface supported." MsgBox "Please check that your scanner is properly connected and powered on and try again later.", vbCritical, "Warning" Resume Handle_Exit Case "User cancelled." MsgBox "Scan cancelled by user.", vbCritical, "Warning" Resume Handle_Exit Case "The remote procedure call failed.." MsgBox "RPC failed. Please check scanner settings in windows.", vbCritical, "Warning" Resume Handle_Exit Case Else MsgBox "Oops! Something went wrong." & vbCrLf & vbCrLf & _ "In Function:" & vbTab & strProcName & vbCrLf & _ "Err Number: " & vbTab & err.Number & vbCrLf & _ "Description: " & vbTab & err.Description, vbCritical, _ "Error in " & Chr$(34) & strProcName & Chr$(34) Resume Handle_Exit End Select End Sub وهذا بعد التعديل ولكن في مشكلة Public Sub ScanDocs() Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}" Dim strFileName As String Dim Dialog1 As New WIA.CommonDialog, DPI As Integer, PP As Integer, l As Integer Dim Scanner As WIA.Device Dim img As WIA.ImageFile Dim intPages As Integer Dim strFileJPG As String Dim i As Integer Dim blnContScan As Boolean Dim ContScan As String 'msgbox to chk if more pages are to be scanned Dim PdfOverwrite As String 'msgbox to confirm pdf file overwite Dim FSO As New FileSystemObject Dim strFilePDF As String Dim RptName As String Dim strProcName As String strProcName = "ScanDocs" 'On Error GoTo Handle_Err 'empty the scantemp table DoCmd.SetWarnings False DoCmd.RunSQL "delete from scantemp" DoCmd.SetWarnings True strFileName = strDocType 'create a temp folder if it does not exists CreateTempFolder 'if a temp folder is present, delete all files from it DeleteFiles 'Code for scanning 'Must include reference to Microsoft Windows Image Acquisition 2.0 dll blnContScan = True intPages = 0 Do While blnContScan = True DPI = 200 PP = 1 'No of pages 'XXXXXXXXXXXXXXXXXX Set Scanner = Dialog1.ShowSelectDevice(WIA.WiaDeviceType.ScannerDeviceType, True, False) With Scanner.Items(1) .Properties("6146").Value = 1 'Colour intent (1 for color, 2 for grayscale, 4 for b & w) .Properties("6147").Value = DPI 'DPI horizontal .Properties("6148").Value = DPI 'DPI vertical .Properties("6149").Value = 0 'x point to start scan .Properties("6150").Value = 0 'y point to start scan .Properties("6151").Value = 8.27 * DPI 'Horizontal extent .Properties("6152").Value = 11.69 * DPI 'Vertical extent for letter End With Set img = Dialog1.ShowTransfer(Scanner.Items(1), wiaFormatJPEG, True) 'Set img = Scanner.Items(1).Transfer(WIA.FormatID.wiaFormatJPEG) intPages = intPages + 1 strFileJPG = strTempFolder & "\" & strFileName & Trim(Str(intPages)) & ".jpg" ' If FSO.FileExists(strFileJPG) Then ' FSO.DeleteFile (strFileJPG) ' End If ' Set FSO = Nothing img.SaveFile (strFileJPG) DoCmd.SetWarnings False DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG & "')" DoCmd.SetWarnings True Set Scanner = Nothing Set img = Nothing strFileJPG = "" ''هنا محور سؤالى حول الغاء هذه الخطوة قمت بتعكيل الكود ' 'Prompt user if there are additional pages to scan ' ContScan = MsgBox("Scan another page?", vbQuestion + vbYesNo, "Continue...?") ' If ContScan = vbNo Then ' blnContScan = False ' End If Do While Err.Number <> -2145320957 ContScan = yes Loop GoTo StartPDFConversion StartPDFConversion: strFilePDF = strTempFolder & "\" & strFileName & ".pdf" If FSO.FileExists(strFilePDF) Then FSO.DeleteFile (strFilePDF) End If Set FSO = Nothing 'Now let's run an Access report called rptScan and output it to a PDF file on the network 'rptScan is an Access report whose recordsource is the scantemp table RptName = "rptScan" DoCmd.OpenReport RptName, acViewReport, , , acHidden DoCmd.Close acReport, RptName, acSaveYes DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFilePDF CustDocPath = strFilePDF strFilePDF = "" Handle_Exit: Exit Sub Handle_Err: Select Case err.Description Case "The user requested a scan and there are no documents left in the document feeder." MsgBox "Please insert paper into the scanner.", vbCritical, "Warning" Resume Case "ID Not Found." MsgBox "Please check that your scanner is properly connected and powered on and try again later.", vbCritical, "Warning" Resume Handle_Exit Case "No such interface supported." MsgBox "Please check that your scanner is properly connected and powered on and try again later.", vbCritical, "Warning" Resume Handle_Exit Case "User cancelled." MsgBox "Scan cancelled by user.", vbCritical, "Warning" Resume Handle_Exit Case "The remote procedure call failed.." MsgBox "RPC failed. Please check scanner settings in windows.", vbCritical, "Warning" Resume Handle_Exit Case Else MsgBox "Oops! Something went wrong." & vbCrLf & vbCrLf & _ "In Function:" & vbTab & strProcName & vbCrLf & _ "Err Number: " & vbTab & err.Number & vbCrLf & _ "Description: " & vbTab & err.Description, vbCritical, _ "Error in " & Chr$(34) & strProcName & Chr$(34) Resume Handle_Exit End Select End Sub كيف أقوم بالتعديل الصحيح سيدى

Test scan.rar

حتى اسهل الامر عليكم المشكلة في الجزء هذا من الكود 'Prompt user if there are additional pages to scan ContScan = MsgBox("Scan another page?", vbQuestion + vbYesNo, "Continue...?") If ContScan = vbNo Then blnContScan = False End If والموجود في الموديول باسم modProcedures انه يقوم بالمسح الضوئى على اكمل وجه وكما اريد تمام ولاكثر من ورقة ولكن بعد كل ورقة تحرج رساله بسبب هذا السطر ContScan = MsgBox("Scan another page?", vbQuestion + vbYesNo, "Continue...?") فقط اريد التعديل حتى يتم سحب الأوراق دفعة واحدة بدون هذه الرسالة المزعجة ارجوكم ساعدونى والله حاولت كثيرا وفشلت

المثال انه يحتوى على كود يقوم بتحويل الصور الى ملف pdf كما انه يقوم بالمسح والتحويل الى ملفات pdf بدون اى برامج خارجية وسيطه اخرى وهذا لم اجد مثله اساسا كل ما وجدته يعتمد على برامج أخرى فقط اريد هذا المرفق يقوم بالمسح التلقائى لكل الأوراق دفعة واحدة من دون رسالة يا أستاذ @jjafferr

@أبو إبراهيم الغامدي @عبدالرحمن هاشم

Me.LETTERS = DLookup("[Letters]", "SubLetters", "[ID]=" & Me.SUB.Column(1)) Me.LETTERS >> اسم الكائن على النموذج والذى تريد اظهار المحتوى المطلوب من خلاله DLookup >> هي دالة تستخدم في جلب قيم محدده من حقل محدد داخل جدول محدد مع مرعاه الاخذ في الاعتبار نوع الحقل (نص او رقم او تاريخ) وقدم تستخدم غير مشروطة وقد تستخدم بشرط او اكثر حسب متطلباتك DLookup("[FieldName]", "TableName", "Condition=" & xxx) بالعربى كده اجلب قيمة الحقل(FieldName) من الجدول (TableName) بشرط (عندما تكون قيمة حقل اخر في الجدول ) = xxx ( كائن على النموذج)

@ الا ستاذ أبو إبراهيم الغامدي

والأستاذ @Elsayed Bn Gemy

ارجو المساعدة من الاستاذ @Shivan Rekany والاستاذ الكريم @jjafferr والاستاذ @ابوخليل والاستاذ @ابا جودى

السلام عليكم ورحمة الله وبركاته ممكن مساعدة لو تكرمتم كنت ابحث عن قاعدة بيانات تقوم بعمل مسح ضوئى واثناء البحث على الانترنت وجدت هذه القاعدة في احد المنتديات الاجنبية واجهتنى مشكلة انه عند كل صفحة يقوم بمسحها تخرج رساله هل تريد مسح صفحة اخرى اريد ان يقوم بعمل مسح ضوئى لكل الصفحات انا امسح تقريبا اكثر من 100 صفحة الموضوع مزعج جدا حاولت التعديل ولكن فشلت ارجو المساعدة لان الموضوع هام جدا بالنسبة لى من اجمل ما اعجبنى في المثال انه يحتوى على كود يقوم بتحويل الصور الى ملف pdf كما انه يقوم بالمسح والتحويل الى ملفات pdf بدون اى برامج خارجية وسيطه اخرى ولحضراتكم جزيل الشكر مسبقا Test scan.rar