محمد ايمن

اخي الكريم البحث عن طريق رقم الهاتف عملية صعبة قليلا ( لان البحث سيتم في اربع حقول ) اما المدينة فهي محلولة دليل الهاتف 2012 2.rar

اخي الكريم هذه المشكلة حصلت معي كثيرا ولم اجد حلا لها ولكن تستطيع فقط الحصول على الكود Option Compare Database Private Sub bag_dfah_AfterUpdate() If Not Me.NewRecord Then DoCmd.OpenForm "sdad", , , "[id]=" & Me![bag_dfah].Column(0) End Sub Private Sub comp1_AfterUpdate() Me.f6.Visible = False Me.f7.Visible = True Me.f7.Requery End Sub Private Sub comp2_AfterUpdate() Me.f7.Visible = False Me.f6.Visible = True Me.f6.Requery End Sub Private Sub Detail_Click() On Error Resume Next Me.f7.Visible = False Me.f6.Visible = False Me.comp1.SetFocus End Sub Private Sub Form_Load() 'On Error Resume Next 'ReSizeForm Me 'اعادة تحجيم النموذج الرئيسي 'ReSizeForm SubForm.Form 'اعادة تحجيم النموذج الفرعي '[DBOld] = CurrentDb.Name اختيار قاعدة البيانات الحالية Dim bg Dim stDocmstajr As String Dim stLinkCriteria As String bg = DLookup("Result", "Q_bageEgama") If bg > 0 Then If MsgBox("يوجد شخص او اكثر قارب عقدهم على الانتهاء" & vbCrLf & _ "هل تريد رؤيتهم", _ vbInformation + vbYesNo, _ "العقود قريبة الانتهاء") = vbYes Then stDocmstajr = "frm_agd_nhayh" DoCmd.OpenForm stDocmstajr, , , stLinkCriteria End If Else bg = DLookup("Result", "Q_bageEgama1") If bg > 0 Then If MsgBox("يوجد شخص او اكثر انتهت عقودهم " & vbCrLf & _ "هل اريد رؤيتهم", _ vbInformation + vbYesNo, _ "العقود النتهية") = vbYes Then stDocmstajr = "frm_agd_mnthy" DoCmd.OpenForm stDocmstajr, , , stLinkCriteria DoCmd.CancelEvent End If End If End If End Sub Private Sub Form_Open(Cancel As Integer) Me.ico.Picture = Application.CurrentProject.Path & "\images_5.JPG" DoCmd.Maximize Call CountClass1 End Sub Private Sub malk_jdyd_AfterUpdate() If Not Me.NewRecord Then DoCmd.OpenForm "malk", , , "[id]=" & Me![malk_jdyd].Column(0) End Sub Private Sub malk_jdyd_DblClick(Cancel As Integer) DoCmd.OpenForm "frm_malk_jdyd" End Sub Private Sub mstajr_Click() If Not Me.NewRecord Then DoCmd.OpenForm "frm_byan_mstajr", , , "[id]=" & Me![mstajr].Column(0) End Sub Private Sub no_tsdyd_AfterUpdate() If Not Me.NewRecord Then DoCmd.OpenForm "sdad_sabg", , , "[id]=" & Me![no_tsdyd].Column(0) End Sub Private Sub sdad_sabg_AfterUpdate() If Not Me.NewRecord Then DoCmd.OpenForm "sdad_sabg", , , "[id]=" & Me![sdad_sabg].Column(0) End Sub Private Sub sknid_AfterUpdate() If Not Me.NewRecord Then DoCmd.OpenForm "sdad", , , "[sknId]=" & Me![sknid].Column(0) End Sub Private Subامر0_Click() On Error GoTo Err_امر0_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "msakn" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر0_Click: Exit Sub Err_امر0_Click: MsgBox err.Description Resume Exit_امر0_Click End Sub Private Sub امر1_Click() On Error GoTo Err_امر1_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "sdad" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر1_Click: Exit Sub Err_امر1_Click: MsgBox err.Description Resume Exit_امر1_Click End Sub Private Sub امر2_Click() On Error GoTo Err_امر2_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = ChrW(1575) & ChrW(1604) & ChrW(1605) & ChrW(1576) & ChrW(1575) & ChrW(1606) & ChrW(1610) DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر2_Click: Exit Sub Err_امر2_Click: MsgBox err.Description Resume Exit_امر2_Click End Sub Private Subامر3_Click() On Error GoTo Err_امر3_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = ChrW(1576) & ChrW(1610) & ChrW(1575) & ChrW(1606) & ChrW(1575) & ChrW(1578) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1605) & ChrW(1587) & ChrW(1578) & ChrW(1575) & ChrW(1580) & ChrW(1585) & ChrW(1610) & ChrW(1606) DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر3_Click: Exit Sub Err_امر3_Click: MsgBox err.Description Resume Exit_امر3_Click End Sub Private Sub امر5_Click() On Error GoTo Err_امر5_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "wajh_sdad" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر5_Click: Exit Sub Err_امر5_Click: MsgBox err.Description Resume Exit_امر5_Click End Sub Private Sub امر6_Click() On Error GoTo Err_امر6_Click DoCmd.Close Exit_امر6_Click: Exit Sub Err_امر6_Click: MsgBox err.Description Resume Exit_امر6_Click End Sub Private Subامر11_Click() On Error GoTo Err_امر11_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "kdmh" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر11_Click: Exit Sub Err_امر11_Click: MsgBox err.Description Resume Exit_امر11_Click End Sub Private Sub wajb_AfterUpdate() If Not Me.NewRecord Then DoCmd.OpenForm "sdad", , , "[id]=" & Me![wajb].Column(0) End Sub Private Subامر12_Click() Beep If MsgBox("ها انت متأكد من رغبتك في الخروج من البرنامج" & vbCrLf & _ "", _ vbMsgBoxRtlReading + vbMsgBoxRight + vbExclamation + vbYesNo, _ "تنبيه") = vbYes Then DoCmd.Quit End If Exit_امر300_Click: Exit Sub Err_امر300_Click: MsgBox err.Description Resume Exit_امر300_Click End Sub Private Subامر14_Click() On Error GoTo Err_امر14_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "sdad_sabg" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر14_Click: Exit Sub Err_امر14_Click: MsgBox err.Description Resume Exit_امر14_Click End Sub Private Sub امر15_Click() On Error GoTo Err_امر15_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_byan_mstajr" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر15_Click: Exit Sub Err_امر15_Click: MsgBox err.Description Resume Exit_امر15_Click End Sub Private Sub امر22_Click() On Error GoTo Err_امر22_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_mbany_2" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر22_Click: Exit Sub Err_امر22_Click: MsgBox err.Description Resume Exit_امر22_Click End Sub Private Sub امر25_Click() On Error GoTo Err_امر25_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "Control Panel" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر25_Click: Exit Sub Err_امر25_Click: MsgBox err.Description Resume Exit_امر25_Click End Sub Private Subامر26_Click() On Error GoTo Err_امر26_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "wajh_tgaryr" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر26_Click: Exit Sub Err_امر26_Click: MsgBox err.Description Resume Exit_امر26_Click End Sub Private Subامر29_Click() On Error GoTo Err_امر29_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_malk_jdyd_2" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر29_Click: Exit Sub Err_امر29_Click: MsgBox err.Description Resume Exit_امر29_Click End Sub Private Subامر38_Click() On Error GoTo Err_امر38_Click DoCmd.Close Exit_امر38_Click: Exit Sub Err_امر38_Click: MsgBox err.Description Resume Exit_امر38_Click End Sub Private Sub امر43_Click() On Error GoTo Err_امر43_Click DoCmd.Close Exit_امر43_Click: Exit Sub Err_امر43_Click: MsgBox err.Description Resume Exit_امر43_Click End Sub Private Sub امر61_Click() On Error GoTo Err_امر61_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_asasyh" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر61_Click: Exit Sub Err_امر61_Click: MsgBox err.Description Resume Exit_امر61_Click End Sub Private Subامر62_Click() On Error GoTo Err_امر62_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_grop_noa_agar" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر62_Click: Exit Sub Err_امر62_Click: MsgBox err.Description Resume Exit_ÃãÑ62_Click End Sub Private Sub امر63_Click() On Error GoTo Err_امر63_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_grop_dwlh" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر63_Click: Exit Sub Err_امر63_Click: MsgBox err.Description Resume Exit_امر63_Click End Sub Private Sub امر64_Click() On Error GoTo Err_امر64_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_grop_mdynh_f" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر64_Click: Exit Sub Err_امر64_Click: MsgBox err.Description Resume Exit_امر64_Click End Sub Private Sub امر65_Click() On Error GoTo Err_امر65_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_grop_mdynh" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر65_Click: Exit Sub Err_امر65_Click: MsgBox err.Description Resume Exit_امر65_Click End Sub Private Subامر67_Click() On Error GoTo Err_امر67_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_grop_alhi" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر67_Click: Exit Sub Err_امر67_Click: MsgBox err.Description Resume Exit_امر67_Click End Sub Private Subامر68_Click() On Error GoTo Err_امر68_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_grop_jensya" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر68_Click: Exit Sub Err_امر68_Click: MsgBox err.Description Resume Exit_امر68_Click End Sub Private Sub امر69_Click() On Error GoTo Err_امر69_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_grop_wdifh" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_امر69_Click: Exit Sub Err_امر69_Click: MsgBox err.Description Resume Exit_امر69_Click End Sub

اخي الكريم الدالة dsum تكتب كالآتي =DSum("[fildname]","[tablename]","[Condition]") fildname اسم الحقل tablename اسم الجدول Condition الشرط ارجو ان يفيدك هذا

اخواني الاكارم السلام عليكم و رحة الله و بركاته بعد التجريب و الفحص الدقيق تبين وجود خطأ في الكود السابق الخطأ هو ان الكود يقوم بفحص اول جهاز usb يصادفه فاذا لم يكن الرقم مطابق يخرج من البرنامج هذه مشكلة كبيرة فهل معنى هذا ان المستخدم سيضطر الى نزع كافة الاجهزة ليعمل البرنامج ؟؟؟؟ من المؤكد لا الحل هو تغيير ترتيب الحماية المستويات في الكود السابق كانت كالآتي 1 التاكد من صحة الرقم 2 التأكد من ملفات ضمن الفلاش 3 التأكد من رقم ضمن احد هذه الملفات اما المستويات الحالية 1 التأكد من ملفات موجودة ضمن الفلاش ( وهذه الطريقة تضمن الدخول الى الفلاش الصحيح للبرنامج ) 2 التاكد من الرقم التسلسي للفلاش 3 التاكد من رقم ضمن احد هذه الملفات وانا بانتظار تجربتكم و آرائكم استخراج رقم الفلاش ميموري 6.rar

لك ذلك اخي الكريم واكن فقط اعطني بعض الوقت

اخي الكريم ارفع ملف مرفق و انشالله سنجد حلا لك

رفم مستوى الحماية الى ثلاث مستويات : بسم الله الرحمن الرحيم و به نستعين اخواني الاكارم البرنامج السابق و كما قلت يستخرج الرقم الاصلي للفلاش ميموري و هو رقم ثانت لا يتغير ابدا لنفرض و بطريق الصدفة انه حصلت معجزة و تطابق هذا الرقم مع فلاش ميموري اخرى هل هذا يعني ان المستخدم سيملك نسخة ثانية من البرنامج ؟؟؟؟؟ طبعا اذا الحل رفع مستوى الحماية و انا قمت برفعه الى ثلاث مستويات المستوى الاول : رقم الفلاش ميموري المستوى الثاني : ملفات موجودة ضمن الفلاش ميموري المستوى الثالث : رقم موجود ضمن احد هذه الملفات نبدأ على بركة الله في البداية و قبل كل شيئ قم بازالة جميع الاجهزة الموصولة بمنافذ usb ضع الفلاش ميموري التي تريد استخراج الرقم الاصلي لها قم بتشغيل البرنامج و استبدل ارقام الفلاش ميموري الكود الاول موجود سابقا ولن اتطرق الى شرحه الكود الثاني وهو خاص بالبحث عن الملفات ضمن الفلاش ميموري Set fso = CreateObject("Scripting.FileSystemObject") Set dc = fso.Drives With CreateObject("Scripting.FileSystemObject") For Each d In .Drives xx = d.driveletter & ":" Next If .FileExists(xx & "\Dummy_Protector_File.ldf") And .FileExists(xx & "\domin.ldf") Then Else MsgBox "خطأ في ملفات دارة الحماية" Exit Sub End If End With هذا الكود يبحث عن الملفين Dummy_Protector_File.ldf و domin.ldf فإذا وجدهما اكمل و اذا لم يجدها يخرج من الكود الكود الثالث وهو يتاكد من صحة نص او رقم موجود ضمن احد هذه الملفات وهو domin.ldf على سبيل المثال Open xx & "\" & "Domin.ldf" For Input As #1 Do While Not EOF(1) Line Input #1, y Loop Close #1 If [y] <> "66cfe929b73cd1b8" Then MsgBox "الرقم التسلسي للنسخة غير صحيح" End If Exit Sub و الآن يجب الربط الكودات الثلاثة فتصبح النتيجة Dim d, fso, dc As Object Dim chek, xx As String Dim objWMIService, objItem, colItems, strComputer, IDD On Error Resume Next strComputer = "." Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive") For Each objItem In colItems If objItem.InterfaceType = "USB" Then chek = objItem.PNPDeviceID If chek <> "USBSTOR\DISK&VEN_GENERIC&PROD_USB_FLASH_DISK&REV_0.00\01AF0000000003EA&0" Then ' غير هذا الرقم الى رقم الفلاش الخاص بك MsgBox "الرقم غير صحيح" Exit Sub Else Set fso = CreateObject("Scripting.FileSystemObject") Set dc = fso.Drives With CreateObject("Scripting.FileSystemObject") For Each d In .Drives xx = d.driveletter & ":" Next If .FileExists(xx & "\Dummy_Protector_File.ldf") And .FileExists(xx & "\domin.ldf") Then ' غير اسماء الملفات و امتداها Open xx & "\" & "Domin.ldf" For Input As #1 Do While Not EOF(1) Line Input #1, y Loop Close #1 If [y] <> "66cfe929b73cd1b8" Then ' غير هذا النص MsgBox "الرقم التسلسي للنسخة غير صحيح" End If Exit Sub Else MsgBox "خطأ في ملفات دارة الحماية" Exit Sub End If End With End If End If Next MsgBox "قم بتوصيل دارة الحماية" و اخيرا يجب اضافة خطوة جمالية الى الفلاش لكي تصبح شبيهة بالدنكل وهي وضع ملف يقوم بحجز كامل المساحة في الفلاش ميموري اسم البرنامج Dummy File creator برنامج بسيط جدا يعطي ملف يحجز كامل مساحة الفلاش ميموري و الشرح موجود في الصور الآن انا بانتظار تجربتكم و نتائجكم و آرائكم Dummy File creator.rar استخراج رقم الفلاش ميموري 5.rar

استاذي و معلمي نارت انا لي الشرف و كل الشرف بان اضع اسمك على احد برامجي

اخي الكريم تستطيع استخدام احد الكودين docmd.gotocontrol"aa" او me.aa.setfouces aa هو اسم الحقل الذي تريد التركيز عليه

هل تقصد ان يكون قائمة منسدلة في نموذج البحث ؟

اخي الكريم جرب المرفق التالي حيث اسم المستخدم admin الباسوورد admin يوجد داخل الجدول useraccount خانة اسمها pro اذا وضعت ( صح ) في هذه الخانة عندها لا يمكن حذف هذا المستخدم ابدا صلاحيات المستخدمين.rar

؟؟؟؟؟؟؟

اخي نارت الفضل طبعا لله عز وجل ولكن انت قمت بالعمل الحقيقي وانا بانتظر النتائج من الاخوة

ضع الكودات في حدث التحميل الخاص بالنموذج

جرب الكود التالي Dim aa As String DoCmd.GoToRecord , , acLast aa = simplename DoCmd.GoToRecord , , acNewRec semplename2 = aa semplename هو اسم الحقل الذي نريد قيمته semplename2 هو اسم الحقل الذي نخزن فيه قيمة آخر حقل و هو غير منضم

السلام عليكم و رحمة الله و بركاته بسم الله الرحمن الرحيم و الحمد لله رب العاليمن و الصلاة و السلام على سيد المرسلين نبينا محمد ( صلى الله عليه و سلم ) الحمد لله الذي هدانا لهذا و ما كنا لنهتدي لو لا ان هدانا الله اما بعد اخواني الكرام جميعنا يفكر بكيفية حماية برنامجه المصنوع بواسطة الاكسسز و تعددت الطرق منها الحماية بزراعة ملف نصي و الحماية عن طريق رقم الهارد إلخ........ وطبعا المعرف ان افضل طريقة للحماية هي عن طريق الدنكل ولكن الدنكل غالي الثمن اذا كان لابد من ايجاد طريقة للحماية ولكن بسعر رخيص واقرب شيئ للدنكل هو الفلاش ميموري ولكن كيف ستطبق الحماية الطرق التي انتشرت للحماية عن طريق الفلاش ميموري كانت تستخرج الرقم التسلسي للفلاش ميموري ولكن هناك مشكلة ان هذا الرقم يتغير عند اجراء تهيئة للفلاش ( فورمات ) اذا فهذه الطريقة ضعيفة :wallbash: ولكن ماذا اذا حصلت على الرقم التسلسي الاصلي الذي لا يتغير ابدا :smile: عندها لن يتائر برنامجك حتى عند عمل فورمات للفلاشة و سيبقى محميا و قابل للاستخدام من قبل الشخص الذي يملك الفلاش ميموري حصرا اترككم مع المرفقات و ارجو ابداء الرأي حول الموضوع ملاحظة البرنامج ليس مجاني انما مأجور و الأجرة هي الدعاء للاستاذ الكبير نارت لبزو ( ابو آدم ) استخراج رقم الفلاش ميموري 4.rar

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

جرب المرفق التالي اخي الكريم دليل الهاتف 2012.rar

اخي الكريم جرب الرابط التالي يمكن يفيدك http://www.officena.net/ib/index.php?showtopic=534&hl=%2B%D9%83%D9%88%D8%AF+%2B%D8%B9%D8%AF%D9%85+%2B%D8%AA%D9%83%D8%B1%D8%A7%D8%B1+%2B%D8%A7%D9%84%D8%B3%D8%AC%D9%84%D8%A7%D8%AA&fromsearch=1 ولي طلب خاص منك ياريت ترفع القاعدة بصيغة 2003 في المرات القادمة

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

اخي الكريم لن اكذب و اقولك فهمت 100% ولكن هل جربت مشاريع اكسسز ؟؟؟ انتبه لا تحول كامل قاعدة البيانات الى مشروع اكسسز فقط قم بتصير الجدوال الى sql ثم حاول الاتصال بالقاعدة السيرفر ادرك ان الشرح غير مفهوم ولكن حاول تطبيق الآتي قم بتقسيم القاعدة الى جداول وواجهات الجداول data والواجهات view ادخل الى القاعدة التي تحتوي الجداول data واختر معالج التكبير ثم اختر تصدير الى sql ( لا تختر انشاء قاعدة جديدة ) ضع اسم قاعدة sql ثم التالي ستلاحظ بعد الانتهاء ان هناك جدولين الاول ayman وشكله مثل الكرة الارضية والثاني local_ayman وشكله جدول عادي اذهب الى القاعدة view التي تحتوي على النماذج و ارتبط بالجداول التي شكلها كالكرة الارضية ضع قاعد جديدة تحتوي على النماذج على جهاز آخر و ارتبط بالقاعدة data وقم بالتجربة وساحاول ان ارفع شرحا بالصور ملاحظة لابد من توفر msde sqldisktopengine ملاحظة اخرى القاعدة Data يجب ان تكون متوفرة على جهاز السيرفر اما القاعدة view على الاجهزة الاخرى

السلام عليكم ورحمة الله و بركاته اخي نارت في البداية اسال الله عز وجل ان يجزيك الجنة وكل خير اخي نارت اغبطك على خبرتك واتمنى ان يكون لدي 1 من 100000 من خبرتك الكود يعمل بشكل صحيح ولكن هناك بعض التعديلات التي اريدها اولا الكود يعطي رسالة لكافة الاقراص وهو يجب ان يعطي رسالة للقرص القابل للازالة فقط ( الفلاش ميموري ) ثانيا الكود يعطي رقم الفلاش كمايلي : USBSTOR\DISK&VEN_GENERIC&PROD_USB_FLASH_DISK&REV_0.00\01AF0000000003EA&0 بينما يجب ان يعطي 01AF0000000003EA فقط استخراج رقم الفلاش ميموري 2.rar

امهلني فقط بعض الوقت اخي الكريم

هل من جديد

10000000000000000000000000000000000000000000000000000000000000000000000000000 شكر هذا هو المطلوب بعينه :signthankspin: :signthankspin: :signthankspin: للجميع