omarAbdalrazaq

رائع وجميل واداة مفيدة جدا في عملنا جعلة الله في ميزان حسناتك

مبدع وجميل بارك الله فيك وجعلة في ميزان حسناتكم

يا الله

السلام عليكم ورحمة الله اساتذتنا واخواننا في هذا المنتدى الجميل ارجو افادتي حول تعديل الكود الخاص بالسكنر المطلوب: تصغير حجم الصورة الماخوذة بالسكنر حيث ان كل صورة يبلغ حجمها 5 ميجا تنبيهي الى الاخطاء الموجودة في الكود لغرض التعلم هذا ولكم الاجر والثواب تحياتي للجميع Option Compare Database Option Explicit Dim destinationFolder As String Dim myScanPath As String Dim myScanPathWithID As String Dim myImageFullName As String Private Sub btnClose_Click() DoCmd.Close End Sub Private Sub btnDelete_Click() 'Make Sure PicPath not Null If IsNull(Path) Then MsgBox "لا بوجد مسار للصورة حتى تتم عملية الحذف", vbCritical + vbOKOnly, "نقص معلومات" Exit Sub End If On Error Resume Next If MsgBox("سيتم حذف المرفق نهائيا ولا يمكن التراجع عن الحذف مرة اخري", _ vbQuestion + vbYesNo + vbMsgBoxRight + vbDefaultButton2, _ "تأكيد الحذف") = vbYes Then DoCmd.RunCommand acCmdDeleteRecord Else DoCmd.CancelEvent End If End Sub Private Sub btnHdd_Click() 'Make Sure EmpID not Null If IsNull(EmpID) Or IsNull(TypeOfDocument) Or IsNull(DocumentNumber) Or IsNull(DocumentNumber) Or IsNull(FaceOrBack) Then MsgBox "يرجى اكمال المعلومات في الحقول قبل استعمال نسح صورة من الهارد", vbCritical + vbOKOnly, "نقص معلومات" Exit Sub End If Dim Syso As Object Dim MyFile As String myScanPath = "D:\MyScanDB" myScanPathWithID = myScanPath & "\" & [EmpID] Dim fso As Object Set fso = CreateObject("scripting.filesystemobject") If Not fso.FolderExists(myScanPathWithID) Then fso.createfolder (myScanPathWithID) End If Dim Addfile As Object Set Addfile = Application.FileDialog(3) With Addfile .AllowMultiSelect = False .InitialFileName = "" .Filters.Clear .Filters.Add "All Files", "*.*" If .Show = True Then MyFile = Trim(.SelectedItems(1)) destinationFolder = myScanPathWithID & "\" & [TypeOfDocument] & " " & [DocumentNumber] & " " & Format([DocumentDate], "yyyy-mm-dd") & " " & [FaceOrBack] & " " & Format([DateOfTransfer], "yyyy-mm-dd hh-mm-nn-ss") & ".jpg" Me.Path = destinationFolder DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, destinationFolder Set Syso = Nothing Else Exit Sub End If End With End Sub Private Sub btnPrevew_Click() DoCmd.GoToControl "Path" If IsNull(Me![Path]) Then MsgBox "لايوجد مرفق" Else Application.FollowHyperlink [Path] End If Exit_btnHdd_Click: Exit Sub Err_btnHdd_Click: MsgBox Err.Description Resume Exit_btnHdd_Click End Sub Private Sub btnScaner_Click() 'Make Sure EmpID not Null If IsNull(EmpID) Or IsNull(TypeOfDocument) Or IsNull(DocumentNumber) Or IsNull(DocumentNumber) Or IsNull(FaceOrBack) Then MsgBox "يرجى اكمال المعلومات في الحقول قبل استعمال السكنر", vbCritical + vbOKOnly, "نقص معلومات" Exit Sub End If myScanPath = "D:\MyScanDB" myScanPathWithID = myScanPath & "\" & [EmpID] myImageFullName = "" 'Make Sure Folder Exsist if Not Create One destinationFolder = Dir(myScanPathWithID, vbDirectory) If destinationFolder = vbNullString Then VBA.FileSystem.MkDir (myScanPathWithID) End If Dim hg, OldFile, DBwithEXT Dim fdialog As Office.FileDialog Dim filepath As String Dim sdialog As New WIA.CommonDialog Dim imagefile As WIA.imagefile On Error GoTo errorhandle Set fdialog = Application.FileDialog(msoFileDialogSaveAs) OldFile = myScanPathWithID DBwithEXT = Dir(OldFile) hg = myScanPathWithID & "\" & [TypeOfDocument] & " " & [DocumentNumber] & " " & Format([DocumentDate], "yyyy-mm-dd") & " " & [FaceOrBack] & " " & Format([DateOfTransfer], "yyyy-mm-dd hh-mm-nn-ss") & Right(DBwithEXT, 3) With fdialog .Title = "Save as" .AllowMultiSelect = False .InitialFileName = [hg] .InitialFileName = hg + ".bmp" If .Show Then filepath = .SelectedItems(1) ' Else Exit Sub End If Set imagefile = sdialog.ShowAcquireImage() imagefile.SaveFile filepath Me.Path = filepath End With errorhandleexit: Exit Sub errorhandle: MsgBox Err.Description Resume errorhandleexit End Sub MyPic.rar

اشكرك اخي على الاجابة استبدلت الشرط ب where وظهر الخطاء الذي بالصورة المرفقة اريد اجراء استعلام مثل الذي بالصورة

كل عام وانتم بخير

السلام عليكم اخواني واستاذتنا الافاضل. عيد فطر سعيد اعاده الله عليكم وعلينا . ارجو المساعدة في استعلام مجاميع اوجمع Totals عند وضع شرط في احد الاعمدة يظهر الخطاء(data type mismatch in criteria expression) الموجود في الصورة المرفقة. تحياتي للجميع.

اشكرك استاذنا الفاضل جعلة الله في ميزان حسناتك

عفو استاذ لا يسمح الموقع ان ارفعة كون حجمة اكثر من 1 ميجا هذا رابط اخر عسى ان تستطيع تحميلة مع فائق شكري مقدما https://drive.google.com/file/d/1qeLaWW8gqQ-VKpEWgifKd4aEf8QjAH32/view?usp=sharing

https://drive.google.com/file/d/1DtZlIRN5IiHsJX0wtb3f0ZILMzVR68aX/view?usp=sharing

السلام عليكم ورحمة الله اساتذتنا واخواننا في هذا المنتدى تحية لكم ارجو مساعدتي في خطاء برمجي عند الضغط على زر السكنر تظهر لي هذه الجملة (Type mismatch) Private Sub أمر166_Click() On Error Resume Next Dim y y = [dd] & "\" & [رقم الطلب] Dim fs As Object Dim q As Object Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(y) = True Then Else Set q = fs.Createfolder(y) End If Dim hg, OldFile, DBwithEXT Dim fdialog As Office.FileDialog Dim filepath As String Dim sdialog As New WIA.CommonDialog Dim imagefile As WIA.imagefile On Error GoTo errorhandle Set fdialog = Application.FileDialog(msoFileDialogSaveAs) OldFile = Me.x DBwithEXT = Dir(OldFile) hg = y & "\" & [a] & " " & [b] & " " & Format([c], "yyyy-mm-dd") & " " & [d] & "." & Right(DBwithEXT, 3) With fdialog .Title = "Save as" .AllowMultiSelect = False .InitialFileName = [hg] If .Show Then filepath = .SelectedItems(1) ' Else Exit Sub End If Set imagefile = sdialog.ShowAcquireImage() imagefile.SaveFile filepath [ImagePath] = filepath End With errorhandleexit: Exit Sub errorhandle: MsgBox Err.Description Resume errorhandleexit End Sub

استاذنا الفاضل عملت ما قلت لي وما زالت المشكلة موجودة انا اعلم ان المشكلة في الرتب ولكن استطيع توحيد الرتب لان لكل سائق رتبة وانا استخدمها في دالة (horizontal) اذا لم يكن هناك حل لمشكلتي فهل تنصحني بان اجعلها في حقل نصي(اسماء السواق جميعهم) في النموذج الرئيسي ولكن سافقد معلومات كثيرة احتاجها وضعتها في جدول اسماء السواق تحياتي للجميع

اشكرك اخي ولكن للتوضيح لدي جدول رئيسي فية تفاصيل السيارات وجدول فرعي فية اسماء السواق (اكثر من سائق) اردت جمع خقول السواق في حقل واحد في الاستعلام فساعدني اساتذتنا في هذ المنتدى جزاهم الله خيرا بعمل ذلك من خلال دالة (horizontal) ولكن المشكلة ان الحقول في الاستعلام تكررت وانا اريدها بدون تكرار

استاذنا العزيز اشرف مسحت العمودين الاخيرين وبقت نفس المشكلة وهل يمكن ان اضع فقط السجل الاخير لكل عجلة فيما بخص الجدولين الاخيرين حتى اتلافة المشكلة؟ هل اذا لغيت الرتبة من دالة Horizontal تحل المشكلة التكرار؟

السلام عليكم ورحمة الله تحية طيبة الى اعضاء هذا المنتدى عندي مشكلة واتمنى من استذتنا و اخواننا مساعدتي بها المشكلة هي: تكرار السجلات في الاستعلام المسمى Qry_ToAgnecy ملاحظة: ساعدني اساتذتنا في هذا الموقع سابقا في دمج حقول جدول فرعي في حقل واحد عن طريق دال Horizontal واستخدامة في هذ الاستعلام وسؤوال اخر ان امكن هل استطيع بدل حذف سجل ان ارسلة الى قاعدة بيانات فارغة مشابهة الى قاعدة البيانات الاصلية حتى استطيع في المستقبل الرجوع الية في حالى احتياجي للسجلات المحذوفة الملف في الرابط ادناة تحياتي للجميع https://drive.google.com/open?id=1Wp0sPl-oa6USnQ1CGNCHUJbEqKBMiv4R