اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

طلب تعديل على قاعدة بيانات للمسح الضوئى

A7MD M7MD

بواسطه A7MD M7MD
في قسم الأكسيس Access

 مشاركة

الردود الموصى بها

A7MD M7MD

A7MD M7MD

قام بنشر
قام بنشر

السلام عليكم ورحمة الله وبركاته

ممكن مساعدة لو تكرمتم

كنت ابحث عن قاعدة بيانات تقوم بعمل مسح ضوئى واثناء البحث على الانترنت وجدت هذه القاعدة في احد المنتديات الاجنبية

واجهتنى مشكلة انه عند كل صفحة يقوم بمسحها تخرج رساله هل تريد مسح صفحة اخرى

اريد ان يقوم بعمل مسح ضوئى لكل الصفحات انا امسح تقريبا اكثر من 100 صفحة الموضوع مزعج جدا

حاولت التعديل ولكن فشلت

ارجو المساعدة لان الموضوع هام جدا بالنسبة لى

من اجمل ما اعجبنى في المثال انه يحتوى على كود يقوم بتحويل الصور الى ملف pdf

كما انه يقوم بالمسح والتحويل الى ملفات pdf بدون اى برامج خارجية وسيطه اخرى

ولحضراتكم جزيل الشكر مسبقا

 

Test scan.rar

رابط هذا التعليق
شارك
jjafferr

jjafferr

قام بنشر
قام بنشر

قواعد المشاركة فى الموقع


و بصفة خاصة نؤكدعلى ما يلي
1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة
2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد.
3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال.
4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا.....
5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم.

 

اخي الفاضل ، رجاء الالتزام بقوانين المنتدى ،

المنتدى مليء بالخبراء ، ولكن كلً حسب وقته ،

ولو انك عملت بحث في المنتدى لوجدت ان مثل هذا الموضوع قد تم مناقشته وبأمثله كثيرة.

 

جعفر

رابط هذا التعليق
شارك
A7MD M7MD

A7MD M7MD

قام بنشر
  • الكاتب
قام بنشر
1 دقيقه مضت, jjafferr said:

قواعد المشاركة فى الموقع


و بصفة خاصة نؤكدعلى ما يلي
1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة
2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد.
3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال.
4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا.....
5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم.

 

اخي الفاضل ، رجاء الالتزام بقوانين المنتدى ،

المنتدى مليء بالخبراء ، ولكن كلً حسب وقته ،

ولو انك عملت بحث في المنتدى لوجدت ان مثل هذا الموضوع قد تم مناقشته وبأمثله كثيرة.

 

جعفر

المثال انه يحتوى على كود يقوم بتحويل الصور الى ملف pdf

كما انه يقوم بالمسح والتحويل الى ملفات pdf بدون اى برامج خارجية وسيطه اخرى

وهذا لم اجد مثله اساسا

كل ما وجدته يعتمد على برامج أخرى

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

 

رابط هذا التعليق
شارك
A7MD M7MD

A7MD M7MD

قام بنشر
  • الكاتب
قام بنشر

حتى اسهل الامر عليكم 

المشكلة في الجزء هذا من الكود 

    '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...?")

فقط اريد التعديل حتى يتم سحب الأوراق دفعة واحدة بدون هذه الرسالة المزعجة ارجوكم ساعدونى والله حاولت كثيرا وفشلت

 

 

رابط هذا التعليق
شارك
A7MD M7MD

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

 

كيف أقوم بالتعديل الصحيح سيدى

رابط هذا التعليق
شارك
jjafferr

jjafferr

قام بنشر
قام بنشر

انا لا اعرف شيء عن الكود ، ولم اجربه ولن استطيع مساعدتك اذا كان فيه مشكله ، 

وانما فقط لهذه الجزئية "اعتقد" بانه يجب عليك القيام بهذه التغييرات:

 

بدل هذا السطر

33 دقائق مضت, A7MD M7MD said:

Do While blnContScan = True

 

اكتب

33 دقائق مضت, A7MD M7MD said:

Do While Err.Number <> -2145320957

 

والغي هذه السطور 

    '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

 

جعفر

رابط هذا التعليق
شارك
ابو جودي

ابو جودي

قام بنشر
قام بنشر

السلام عليكم

اعتذر جدا جدا جدا جدا جدا عن عدم القدرة على تقديم المساعدة الان
انا لست فى العمل حتى استطيع تجربة المرفق انا اجازة وقد تطول قليلا
ان شاء الله يوم الخميس القادم سيتم اجراء عملية جراحية لى ان شاء الله 
قم بتجربة حل الاستاذ الكريم ووالدى الحبيب الاستاذ @jjafferr واسال الله ان يهئ لك من امرك رشدا ان شاء الله

رابط هذا التعليق
شارك
  • 2 weeks later...
  • 2 weeks later...
ابو محمد 316

ابو محمد 316

قام بنشر
قام بنشر

السلام عليكم 

جرب هذا الملف يمكن ينفع 

يسبح الصور من SCAN ويحفظه بصيغة pdf  وايضن يحفظه كصوره

ويحفظ موقع الملف pdf  في جدول و موقع الصورة في جدول اخر

هذى المثال من موقع اجنبي 

إن شاء الله يقيدك

بالتوفيق إن شاء لله

 

scan 2019.rar

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept