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

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

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

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

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

جعفر

A7MD M7MD · مارس 7, 2019

1 دقيقه مضت, jjafferr said:

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

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

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

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

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

جعفر

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

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

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

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

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

A7MD M7MD · مارس 7, 2019

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

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

    '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 · مارس 7, 2019

Test scan.rar

**jjafferr** · مارس 7, 2019

جرب هذا الاقتراح

جعفر

A7MD M7MD · مارس 7, 2019

أستاذ @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** · مارس 7, 2019

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

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

بدل هذا السطر

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

جعفر

**ابو جودي** · مارس 11, 2019

السلام عليكم

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

A7MD M7MD · مارس 24, 2019

up 😃

تم تعديل مارس 24, 2019 بواسطه A7MD M7MD

ابو محمد 316 · أبريل 1, 2019

السلام عليكم

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

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

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

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

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

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

scan 2019.rar

تسجيل الدخول

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

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

A7MD M7MD

A7MD M7MD

A7MD M7MD

A7MD M7MD

A7MD M7MD

jjafferr

A7MD M7MD

A7MD M7MD

A7MD M7MD

jjafferr

A7MD M7MD

jjafferr

ابو جودي

A7MD M7MD

ابو محمد 316

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information