كود لسحب صورة من سكنر لا يعمل

[محمد التميمي]

 

السلام عليكم

اعزائي واستاذيتي الكرام

في المرفق زر (سحب صورة من الاسكنر) لا يعمل بصورة صحيحة (( يقوم بفتح محور الاسكنر ويحدد الصورة وعند الضغط بنعم لا تظهر الصورة في مربع Image1))

الرجاء من جنابكم الكريم النظر في الكود لايجاد المشكلة وساوافيكم بالنتيجة صباح يوم غد باذن الله لان جهاز السكنر متوفر في مكان العمل فقط.

مع فائق الشكر والتقدير استاذي الفاضل

CARD.zip

[Foksh]

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

حالياً لعدم توافر ماسح ضوئي حالياً لدي ، سؤالي هو ، هل يتم فعلاً سحب الصورة من خلال السكانر ( الماسح الضوئي ) ولكن لا يتم عرضها في مربع الصورة ؟؟؟؟

[محمد التميمي]

4 دقائق مضت, Foksh said:

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

حالياً لعدم توافر ماسح ضوئي حالياً لدي ، سؤالي هو ، هل يتم فعلاً سحب الصورة من خلال السكانر ( الماسح الضوئي ) ولكن لا يتم عرضها في مربع الصورة ؟؟؟؟

نعم بالفعل استاذي الكريم

[Foksh]

10 دقائق مضت, محمد التميمي said:

نعم بالفعل استاذي الكريم

حسناً ، جرب هذا التعديل البسيط ,,

Private Sub Comannd187_Click()
Dim fdialog As Office.FileDialog
Dim filepath As String
Dim sdialog As New WIA.CommonDialog
Dim imagefile As WIA.imagefile
On Error GoTo errorhandle

Dim fso As Object
Dim fldrname, fldrpath, FoldrPath As String
FoldrPath = "Pictures"
Set fso = CreateObject("scripting.filesystemobject")
          fldrpath = CurrentProject.Path & "\" & FoldrPath
          If Not fso.FolderExists(fldrpath) Then
             fso.createfolder (fldrpath)
          End If

'==================================
Set fdialog = Application.FileDialog(msoFileDialogSaveAs)
filepath = CurrentProject.Path & "\" & FoldrPath & "\" & Me.Key & ".jpg"
            Set imagefile = sdialog.ShowAcquireImage()
            imagefile.SaveFile filepath
            Me.PicPath2 = filepath
            Image.Requery

errorhandleexit:
        Exit Sub
errorhandle:
If Err.Number = "-2147024816" Then
If MsgBox("توجد صورة تحمل نفس الرقم" & vbNewLine & "هل تريد حذف الصورة القديمة" & vbNewLine & "في حال الرفض سيتم اضافة رقم عشوائي الى اسم الصورة لتمييزها", vbCritical + vbYesNo + vbMsgBoxRight, "تنبيه") = vbYes Then
Kill filepath
            'Set imagefile = sdialog.ShowAcquireImage()
            imagefile.SaveFile filepath
            Me.PicPath2 = filepath
            Image.Requery
Else
Dim g As String
g = CurrentProject.Path & "\" & FoldrPath & "\" & Me.Key & "-" & Format(Now, "hhnnss") & ".jpg"
            imagefile.SaveFile g
            Me.PicPath2 = g
            Me.Image1.Picture = Me.Pic1


End If
ElseIf Err.Number = "-2145320939" Then
MsgBox "الاسكانر غير متصل", vbCritical + vbMsgBoxRight, "تنبيه"
Else
        Me.PicPath2 = Err.Number
        MsgBox Err.Description

End If
        Resume errorhandleexit

End Sub

 

تم تعديل مارس 18, 2025 بواسطه Foksh

[محمد التميمي]

الان, Foksh said:

حسناً ، جرب هذا التعديل البسيط ,,

Private Sub Comannd187_Click()
Dim fdialog As Office.FileDialog
Dim filepath As String
Dim sdialog As New WIA.CommonDialog
Dim imagefile As WIA.imagefile
On Error GoTo errorhandle

Dim fso As Object
Dim fldrname, fldrpath, FoldrPath As String
FoldrPath = "Pictures"
Set fso = CreateObject("scripting.filesystemobject")
          fldrpath = CurrentProject.Path & "\" & FoldrPath
          If Not fso.FolderExists(fldrpath) Then
             fso.createfolder (fldrpath)
          End If

'==================================
Set fdialog = Application.FileDialog(msoFileDialogSaveAs)
filepath = CurrentProject.Path & "\" & FoldrPath & "\" & Me.Key & ".jpg"
            Set imagefile = sdialog.ShowAcquireImage()
            imagefile.SaveFile filepath
            Me.PicPath2 = filepath
            Image.Requery

errorhandleexit:
        Exit Sub
errorhandle:
If Err.Number = "-2147024816" Then
If MsgBox("توجد صورة تحمل نفس الرقم" & vbNewLine & "هل تريد حذف الصورة القديمة" & vbNewLine & "في حال الرفض سيتم اضافة رقم عشوائي الى اسم الصورة لتمييزها", vbCritical + vbYesNo + vbMsgBoxRight, "تنبيه") = vbYes Then
Kill filepath
            'Set imagefile = sdialog.ShowAcquireImage()
            imagefile.SaveFile filepath
            PicPath = filepath
            Image.Requery
Else
Dim g As String
g = CurrentProject.Path & "\" & FoldrPath & "\" & Me.Key & "-" & Format(Now, "hhnnss") & ".jpg"
            imagefile.SaveFile g
            Me.PicPath2 = g
            Me.Image1.Picture = Me.Pic1


End If
ElseIf Err.Number = "-2145320939" Then
MsgBox "الاسكانر غير متصل", vbCritical + vbMsgBoxRight, "تنبيه"
Else
        Me.PicPath2 = Err.Number
        MsgBox Err.Description

End If
        Resume errorhandleexit

End Sub

 

بارك الله بجهودك استاذي الكريم

ساجرب الكود عل جهاز الماسح الضوئي في مكان عملي واوافيك بالرد غدا باذن الله  

مع التقدير...

[ابو جودي]

وايضا يمكنكم تجربة الكود فى هذا المرفق 

مع تغير المسار الرئيسي لمجلد حفظ الصور داخل الكود
 

Public Function MainFolderpath()
    MainFolderpath = "\\192.168.85.70\hr-app\ScanFile\"
End Function

 

ScanerSettings.accdb

[محمد التميمي]

12 ساعات مضت, محمد التميمي said:

بارك الله بجهودك استاذي الكريم

ساجرب الكود عل جهاز الماسح الضوئي في مكان عملي واوافيك بالرد غدا باذن الله  

مع التقدير...

السلام عليكم 

استاذي الكريم Foksh نعم الكود يعمل بشكل جيد

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

مع التقدير....

 

 

 

تم تعديل مارس 19, 2025 بواسطه محمد التميمي

[محمد التميمي]

12 ساعات مضت, ابو جودي said:

وايضا يمكنكم تجربة الكود فى هذا المرفق 

مع تغير المسار الرئيسي لمجلد حفظ الصور داخل الكود
 

Public Function MainFolderpath()
    MainFolderpath = "\\192.168.85.70\hr-app\ScanFile\"
End Function

 

ScanerSettings.accdb 672 kB · 5 downloads

كل الشكر والتقدير لاستاذنا الكبير ابا جودي المحترم

[Foksh]

12 ساعات مضت, محمد التميمي said:

نعم الكود يعمل بشكل جيد

الحمد لله 😇 

هل اكتشفت اين كان الخلل 😁😉 ؟؟؟

[محمد التميمي]

10 ساعات مضت, Foksh said:

الحمد لله 😇 

هل اكتشفت اين كان الخلل 😁😉 ؟؟؟

السلام عليكم

حسب فهمي القاصر كان المروض ان تكتب هكذا ( Me . picpath2) بدل ما في الصورة