نجوم المشاركات

السلام عليكم الوقت كان متأخر ، وحطيت لك كلمتين بدون شرح ، فأعتذر منك ضع الكود على حدث النقر على الزر: نفترض اسماء الحقول رقم المورد: No = 0292 من رقم: From = 02920501 الى رقم: To = 02920509 مقارنة الاربعة ارقام الاولى من اليسار left(me.From,4) = 0292 left(me.To,4) = 0292 if left(me.From,4) <> left(me.To,4) or _ left(me.From,4) <> me.No or _ left(me.To,4) <> me.No then msgbox "Numbers Don't match" end if جعفر

الدرس السابع: دوال التاريخ أخوتي الكرام حياكم الله سوف نقوم في هذا الدرس بشرح دوال التاريخ: ()CDate: تستخدم هذه الدالة من أجل تحويل سلسلة إلى تاريخ. مثال: CDate(السلسلة) CDate("122010")="18-01-2234" ()Date: تستخدم هذه الدالة من أجل إرجاع تاريخ النظام الحالي. مثال: Date()="19/02/2017" DateDiff: تستخدم هذه الدالة لحساب الفرق بين تاريخين DateDiff(أول أسابيع السنة,أول أيام الأسبوع,التاريخ الثاني,التاريخ الأول,رمز الفاصل الزمني) DateDiff("d","14/02/2017","19/02/2017")=5 في هذا المثال حسبنا الفرق بين التاريخين بالأيام DatePart: تستخدم هذه الدالة للحصول على جزء معين من تاريخ محدد لها.(سنة أو يوم أو شهر) مثال: DatePart(أول أسابيع السنة,أول أيام الأسبوع,التاريخ,فاصل زمني) DatePart("d","22/03/2017")=22 DatePart("m","22/03/2017")=3 DatePart("yyyy","22/03/2017")=2017 DateSerial: تستخدم هذه الدالة لإرجاع متغير من نوع تاريخ من ثلاث متغيرات رقمية تمثل السنة والشهر واليوم . مثال: DateSerial(يوم,شهر,سنة) DateSerial("1999","03","20")="20/03/1999" DateValue: تستخدم هذه الدالة من أجل تحويل تعبير معين إلى تاريخ . مثال: DateValue(«التاريخ») DateValue("12 02 2016") Day: تستخدم هذه الدالة لإرجاع رقما من 1 إلى 31 يمثل اليوم من الشهرللتاريخ الممر لها . مثال: Day(التاريخ) Day("15/03/2016")=15 Hour: تستخدم هذه الدالة لإرجاع رقما من 0 إلى 23 يمثل الساعة في اليوم . مثال: Hour(الوقت) Hour("15:25")=15 Minute: تستخدم هذه الدالة لإرجاع رقما من 0 إلى 59 يمثل الدقائق في الساعة. مثال: Minute(الوقت) Minute("15:25")=25 Second: تستخدم هذه الدالة لإرجاع رقما من 0 إلى 59 يمثل الثواني في الدقائق. مثال: Second(الوقت) Second("15:20:23")=23 Month: تستخدم هذه الدالة لإرجاع رقما من 0 إلى 12 يمثل الشهر في السنة. مثال: Month(التاريخ) Month("12/11/2003")=11 Year: تستخدم هذه الدالة لإرجاع رقما يمثل السنة. مثال: Year(التاريخ) Year("12/12/2017")=2017 نكمل البقية فيما بعد إن شاء الله

بعد البحث وصدفة وجدت الحل في قاعدة بيانات عمل نسخه احتياطية من احد المواقع الاجنبية طبعا قمت بتغيير الفاصل الزمني لعداد الوقت من 10000 الى 1000 وكانت النتيجة افضل كما قمت بنسخ الكود الخاص بهذا النموذج من قاعدة البيانات المرفقة كما يلي : Public Function LoadData(strData As String) DoCmd.OpenForm "frmLoading" Forms!frmloading!Label2.Caption = strData Pause 0.1 End Function Public Function Pause(NumberOfSeconds As Variant) On Error GoTo Err_Pause Dim PauseTime As Variant, Start As Variant PauseTime = NumberOfSeconds Start = Timer Do While Timer < Start + PauseTime DoEvents Loop Exit_Pause: Exit Function Err_Pause: MsgBox Err.Description, , " Predator Software Backup Utility" Resume Exit_Pause End Function كما ان النموذج يكون به الكود التالي : Private Sub Form_Load() On Error GoTo Err_Form_Load DoCmd.MoveSize , 4700 Exit_Form_Load: Exit Sub Err_Form_Load: MsgBox Err.Description, , " Predator Software Backup Utility" Resume Exit_Form_Load End Sub Private Sub Form_Timer() On Error GoTo Err_Form_Timer DoCmd.Close acForm, Me.Name Exit_Form_Timer: Exit Sub Err_Form_Timer: MsgBox Err.Description, , " Predator Software Backup Utility" Resume Exit_Form_Timer End Sub كما استخدمت الكود التالي عند ضغط زر امر فتح التقرير من النموذج كما يلي : Call LoadData("PLEASE WAIT ........") docmd.openform"MyFrm" فقط وكانت النتيجة روعه اليكم المرفق وانظروا لنموذج الانتظار : BackUp Utility.zip

السلام عليكم ورحمة الله تم إدراج معادلاتك نفسها في مربع كل تاكست بوكس، أرجو أن تفي الغرض المطلوب... بن علية معرفة الرصيد.rar

وعليكم السلام يمكن شئ من هذا يصلح: if left(me.From,4) <> left(me.To,4) or _ left(me.From,4) <> me.No or _ left(me.To,4) <> me.No then msgbox "Numbers Don't match" end if جعفر

شكرا جزيلا لك استاذ محمد يستاهل الترقية ، والله ان شاء الله يعينه على المسؤولية جعفر

السلام عليكم و رحمة الله تعالى وبركاته إخوتي الكرام حياكم الله. إليكم هذا البرنامج الصغير الذي يقوم بإظهار شريط طباعة مع كل تقرير و بإستعمال أكواد قليلة يقوم شريط الطباعة بضبط إعدادات الصفحة ، طباعة الصفحة الحالية، طباعة الصفحات التي تريدها حسب الإختيار، التكبير و التصغير ، الإنتقال بين السجلات، عرض مجموعة من الصفحات في التقرير. رغم أنه يوجد مثال من قبل للأستاذة زهرة حفظها الله. إلا أنني في هذا المثال إستعملة طريقة مغايرة قليلا و بإستعمال أسطر أقل. إنشاء شريط طباعة.rar

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

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

في موضوع لاخي الكريم // مؤمن جمعة (عمل لوحه UserForm بترحيل بيانات) علي الرابط التالي http://www.officena.net/ib/index.php?showtopic=49583&hl= وطلبه لتصميم برنامج لمتابعة حركة السيارات وتسجيل العمليات المتعلقة ونظرا لان عنوان الموضوع لا يدل علي محتواه وبعد اذن ادارة المنتدي طرحت الموضوع بشكل منفصل حتي يكون في متناول الجميع ولسهولة البحث بعد ذلك بالمنتدي الكريم ويمكن تعديل القاعدة لتتلائم مع شركات تاجير السيارات واضافة حساب كيلومترات السيارة وتكلفة الايجار علي حسب الحاجة وادعوا الله ان يكون الموضوع فيه الفائدة للسائل او الباحث شرح موجز لوظائف الفورم ولا تنسونا بدعوة بظاهر الغيب بصلاح الحال متابعة السيارات.rar

نرحب بالأخ صالح حمادي فى فريق الموقع أهلا وسهلا

في الفترة السابقة قمت بتطبيق هذة الفكرة للتحكم بمستويات الصلاحيات واحببت اليوم مشاركتها معكم لتعم الفائدة واستفيد من اي مقترحات وملاحظات على هذة الطريقة الفكرة: ان يتم تحديد الصلاحية لكل مستخدم ولكل نموذج او تقرير من حيث فتح النموذج او التقرير ، اضافة سجل جديد ، حذف سجل ، تعديل السجلات التطبيق : انشاء جدول للمستخدمين (رقم المستخدم ، اسم المستخدم وكلمة مرور) انشاء جدول للصلاحيات يحتوي على رقم متسلسل ، رقم الموظف، اسم الكائن ، .... وبعد ذلك اي صلاحية تريدها مثل صلاحية فتح، صلاحية تعديل، صلاحية اضافة ،صلاحية الحذف * الجداول مرتبطة ببعضها عن طريق رقم المستخدم انشاء نموذج للدخول الى البرنامج (اسم مستخدم وكلمة مرور) انشاء نموذج للتحكم بالصلاحيات مستند الى جدولي المستخدمين والصلاحيات انشاء وتعميم وظيفة لتطبيق الصلاحية عند فتح نموذج او تقرير باسم Privilege الية العمل: عند الدخول باسم مستخدم صحيح سيتم تخزين رقم المستخدم الحالي في متغير اسمة UsrID وبعد ذلك عند فتح اي نموذج او تقرير يتم استدعاء الوظيفة Privilege للتحقق من ان لهذا المستخد صلاحية فتح نموذج ام لا واذا كان لا فانه ستظهر رسالة بانه لا يملك الصلاحيات ، كما سيتم قبل ان يفتح النموذج ثم سيتم التحقق من ان له صلاحية التعديل ام لا وعندها سيتم تفعيل التعديل او تعطيله حسب الصلاحية ...وهكذا طريقة تعديل واضافة الصلاحيات: تم اضافة نموذج للتحكم بالصلاحيات يتم من خلاله تحديد اسم المستخدم وتحديد اسم النموذج ثم يتم اختيار صلاحيات هذا المستخدم على هذا النموذج وبخصوص قائمة النماذج والتقارير تم استخدام جدول النظام MSysObjects فيديو يوضح الطريقة https://youtu.be/AmfpDgLWUBg الصلاحيات حسب المستخدم و نوع الكائن .rar

الأخ الكريمابو حمادة السلام عليكم استبد الكود بالكود التالى Private Sub CommandButton1_Click() If Val(TextBox1.Text) > Val(Me.TextBox2.Text) Then MsgBox "ÚÝæÇ áÇíæÌÏ ÑÕíÏ ßÇÝí ÇáÑÕíÏ ÇáãæÌæÏ " & vbCr & vbCr & (Me.TextBox2.Value), 16, "ÊÍÐíÑ": Me.TextBox1.SetFocus: Exit Sub UserForm2.Show End Sub

وعليكم السلام ورحمة الله وبركاته الأخ العزيز /ابو حمادة ضع الكود فى حدث ()TextBox1_AfterUpdate وإن شاء الله يكون المطلوب تقبل تحياتى مهم1.rar

وعليكم السلام اولا ، ارفق لك تغيير جدا طفيف ، وهو لتوقيف الخطأ اذا لم يكن هناك سجلات ، ثانيا ، المعادلة التي تفضلت بها غير عن المعادلة التي ارفقتها انا ، فما ادري اذا انت عملت تغيير آخر كذلك ّّ والافضل انك ترفق برنامجك الذي اعطاك الخطأ. Option Compare Database Public B As Long Public x() Public B2() Function Bal(ID, C, D) On Error GoTo err_Bal 'C = Cash 'D = Depo 'Do this for entry to the Function If B = 0 Then 'asign a Zero value to x(), 'we will need this so that the Function will NOT repeat 'going over the old records over and over due to scrolling the Query up and down Dim rst As DAo.Recordset Set rst = CurrentDb.OpenRecordset("SELECT * FROM Qry_Cust_Deno_Depo WHERE [Receipt Date]=" & DateFormat([Forms]![Search]![MyDate])) rst.MoveLast: rst.MoveFirst RC = rst.RecordCount ReDim x(RC) ReDim B2(RC) For i = 1 To RC x(rst![Receipt Number]) = 0 rst.MoveNext Next i rst.Close: Set rst = Nothing End If If x(ID) = 0 Then '1st entry asigns values C = Replace(C, "-", 0) D = Replace(D, "-", 0) B = C + B - D Bal = B x(ID) = 1 B2(ID) = B Else 'for further visits, just take the already asigned value Bal = B2(ID) End If Exit_Bal: Exit Function err_Bal: If Err.Number = 3021 Then Resume Exit_Bal Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function Function DateFormat(varDate As Variant) As String 'Purpose: Return a delimited string in the date format used natively by JET SQL. 'Argument: A date/time value. 'Note: Returns just the date format if the argument has no time component, ' or a date/time format if it does. 'Author: Allen Browne. allen@allenbrowne.com, June 2006. ' 'calling the Function: DateFormat(The_Date_Field) 'a = dlookup("[some field]","some table","[id]=" & me.id & " And DateFormat(The_Date_Field)") ' If IsDate(varDate) Then If DateValue(varDate) = varDate Then DateFormat = Format$(varDate, "\#mm\/dd\/yyyy\#") Else DateFormat = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#") End If End If End Function جعفر 597.1.Test2.accdb.zip

عفوا منك سيد ماكسويل انا نزلت المرفق وبحث بالتواريخ 18\2\2017 و 19 و 20 وما طلعت معي ذاك لمشكلة لكن رغم ذلك اكتب في الاول الكود زر Run Query هذا الكود On Error Resume Next تحياتي

جزاك الله خيرا وبارك لك

تفضل أخي هاني أمين .. هنالك بعض التعديلات على الجدول فقد غيرت خصائص حقل تاريخ الميلاد واضفت حقل العمر تحياتي فصل الاسم وتاريخ الميلاد.zip

الاستاذ الفاضل والعزيز / ابوالبراء الف شكر وتحية لشخصك الكريم وجعلة اللةفى ميزان حسناتك . هذا ماكنت ابحث عنة .. وقبل قليل كنت اتصفح احد مواضيعك فى office for all تقبل فائق التحية والاحترام

السلام عليكم لتحديد مسار مختلف لكل زر عليك ان تضيف متغير من نوع String وتكون قيمتة هي الرسالة وبعد ذلك تستخدم عبارة IF وهذا مثال : Dim Msg As String Msg = MsgBox("aaaaa", vbYesNoCancel) If Msg = vbYes Then MsgBox "yes" ElseIf Msg = vbNo Then MsgBox "no" Else MsgBox "cancel" End If

::: الف مبروك اخ صالح ... علم واخلاق وتقى .. اله يعينك على المسؤولية ....

مبارك اخ صالح جزاك الله كل خير ووفقك لتقديم ما ينفع اخوانك تحياتي

بارك الله فيك

الف مبروك استاذ صالح ربي يزيدك من علمه ويرفعك درجات اعلى ان شاء الله

بارك الله فى غفران ووالديها جزاك الله خيرا

الف مبروك استاذ صالح حمادي الله يوفقك ويقويك

مبارك وعقبال مائة سنة - فى طاعة الله

الف الف مبروك الترقية وتستاهل كل خير يالطيب

مجهود ممتاز ونتمنى الاعضاء يطلعوا عليه

ترقية مستحقة ومباركة ان شاء الله

الف الف مبروك استاذ صالح .... والى الامام دائما

الف مبروك اخي الكريم

الف الف مبروك اخوي صالح حمادي

هذه نسخة لأكسس 2003 من برنامج شريط الطباعة إنشاء شريط طباعة.rar

تفضل أخي sandanet لقد قمت بإضافة الشريط إلى ملف و هو يعمل بشكل جيد تنقل بين الصفحات كما تشاء الأول الأخيرة السابقة التالية. report_options2.rar

جرب هذا الماكرو (تستبدل اسم اخر شيت الى Repport لحسن التعامل مع اللغة الاجنبية) مرفق الملف Sub copy_spcial_cells() Dim Ws_Source As Worksheet Dim My_Sheet As Worksheet Dim My_NUm, x, s, lr, k, i As Integer Dim My_Rg As Range Set Ws_Source = Sheets("Repport") With Ws_Source .Select .Range("a4:d1000").ClearContents My_NUm = .Range("b1") End With x = 4 k = Sheets.Count For i = 1 To k - 1 Set My_Sheet = Sheets(i) lr = My_Sheet.Cells(Rows.Count, "e").End(3).Row If lr < 5 Then lr = 5 For s = 5 To lr If Sheets(i).Range("E" & s) = My_NUm Then With Ws_Source .Range("a" & x) = My_Sheet.Range("b1") .Range("b" & x) = My_Sheet.Range("b2") .Range("c" & x) = My_Sheet.Range("b" & s) .Range("d" & x) = My_Sheet.Range("a" & s) End With x = x + 1 End If Next Next End Sub Report salim.rar

تم معالجة الامر market Salim.rar

استيدل الكود بهذا Sub copy_All_visible() Application.ScreenUpdating = False Dim My_sh As Worksheet Dim My_range As Range Dim k, m, lr, i, x As Integer Dim arrsh() As Integer k = Sheets.Count: m = 3: Set My_sh = Sheets(k): My_sh.Range("a3:m1000").ClearContents For i = 1 To k - 1 If Sheets(i).Visible = True Then t = t + 1: x = Sheets(i).Index ReDim Preserve arrsh(1 To t) arrsh(t) = Sheets(i).Index End If Next For y = 1 To UBound(arrsh) With Sheets(arrsh(y)) lr = .Cells(Rows.Count, 1).End(3).Row Set My_range = .Range("a6:k" & lr) End With With My_sh .Cells(m, 1) = Sheets(arrsh(y)).Cells(1, 2) .Cells(m, 2) = Sheets(arrsh(y)).Cells(2, 2) My_range.Copy .Range("c" & m).PasteSpecial xlPasteValues m = m + lr - 4 End With Next My_sh.Activate Range("a3").Select Erase arrsh Application.ScreenUpdating = True End Sub

حل آخر بشكل مباشر بدون الاستعانة بخلية مساعدة لجمع الأسهم .. المعادلة الأولى لحساب عدد الأسهم =MOD(SUM($E$6:$E$9),24) المعادلة الثانية حساب عدد القراريط =MOD(SUM($F$6:$F$9,INT(MOD(SUM($E$6:$E$9)/24,24))),24) المعادلة الثالثة لحساب الأفدنة =SUM($G$6:$G$9,INT(SUM($F$6:$F$9,INT(MOD(SUM($E$6:$E$9)/24,24)))/24),INT(SUM($E$6:$E$9)/576))

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

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

الشيء المهم والذي يجب ان يعرف : ان الضغط والاصلاح لقاعدة البيانات هو عبارة عن عملية يتم من خلالها خطوتين اثنتين وثالثة 1- نسخ القاعدة الى الذاكرة مع الضغط وتغيير الاسم 2- حذف القاعدة الاصلية 3- اعادة لصق ما في الذاكرة واعادة اسمها الاصلي ومن هنا يتبين خطورة العملية فيما لو لم يتم اخذ الاحتياطات اللازمة فالاولى عند تنفيذ العملية ان يسبقها مباشرة في اول الكود عملية اخذ نسخة احتياطية

وعليكم السلام أخوي ابوخليل ما استغرب ، وما خليت بالي على هذه القضية المرفق فيه ملف vbs واللي عادة يكون فيه برنامج مخرب للكمبيوتر ، وفيه برنامج exe كذلك واللي ممكن يخرب الكمبيوتر!! انا جتني هذه الرسالة: . فضغطت على Keep وتم التنزيل سأعمل مجموعة محاولات ، وعلى اساسها سارفع المرفق الصحيح جعفر توصلت الى المرفق الصحيح ، فسأرفعه الان الى رابط الموضوع الاصلي: http://www.officena.net/ib/topic/66836-تشغيل-برنامج-الاكسس-في-اي-مجلد-،-وبدون-رسائل-الأمان/ جعفر

السلام عليكم ورحمة الله تعالى وبركاته أقدم لكم فورم ترحيل بسيط بشرط إكمال باقي البيانات طريقة عمل الفورم: عند الضغط على زر ترحيل سيتحول ليبل الخلية الفارغة إلى لون الأحمر وهكذا إلا إذا أكملت باقي البيانات يتم الترحيل بنجاح فورم ترحيل بشرط إكمال باقي البيانات.rar

الأستاذ / إسلام الشيمي السلام عليكم ورحمة الله وبركاته هذا العمل قد اعجبني كثيراً فاحتفظت به منذ فترة وهو للأستاذنا الكبير / هشام شلبي جزاه الله خيراً وجعل جميع اعماله في ميزان حسناته . إليك الملف. تغيير اسم الخلية مع اسم الورقة.rar

السلام عليكم ورحمة الله وبركاتة منذ فترة قدمت لكم كيفية الحصول على سريال نمبر الهارد ديسك الحقيقى الذى لا يتغير ععند عمل فورمات للهارد ديسك وكان معه ملف مساعد لابد من نسخة الى ملفات النظام يدويا كان على هذا الرابط لمن اراد الاطلاع على بداية الموضوع : سريال نمبر الهارد ديسك الحقيقى الذى لا يتغير عند عمل فورمات ومنذ بضعة ايام اعترض احد الاخوة على انه عند عمل الفورمات يكون الملف المساعد قد تم ازالته رغم علمنا انه عند عمل الفورمات نقوم بنركيب برامجنا التى نعمل عليها فلا يجوز ان نحاول تشغيل ملف اكسيل بدون تركيب برنامج الاكسيل من جديد بعد الفورمات ولكنى وجدت انها فكرة جيده ان يكون استخراج السريال نمر يتضمن نسخ الملف المساعد اتوماتيكيا بدون تدخل وكان هذا البرنامج المرفق عبارة عن ملف هو نفس الملف الموجود بالرابط اعلاه ولكن يقوم بنسخ الملف الساعد ( DLL ) اتوماتيكيا Omar_1.rar

السلام عليكم بما انني بدأت الموضوع لم يهنأ لي بال ولا خاطر فوجدت كود برمجي ارجو منكم تعديله أو تطويعه حسب المتطلبات -1- اولا هذا الكود لقراءة رقم القرص : ويوضع في ThisWorkbook Private Sub rgbGetVolumeInformationRDI(PathName$, DrvVolumeName$, DrvSerialNo$) Dim r As Long Dim pos As Integer Dim HiWord As Long Dim HiHexStr As String Dim LoWord As Long Dim LoHexStr As String Dim VolumeSN As Long Dim MaxFNLen As Long Dim UnusedStr As String Dim UnusedVal1 As Long Dim UnusedVal2 As Long DrvVolumeName$ = Space$(14) UnusedStr$ = Space$(32) r& = GetVolumeInformation(PathName$, _ DrvVolumeName$, Len(DrvVolumeName$), VolumeSN&, _ UnusedVal1&, UnusedVal2&, UnusedStr$, Len(UnusedStr$)) If r& = 0 Then Exit Sub 'determine le label pos% = InStr(DrvVolumeName$, Chr$(0)) If pos% Then DrvVolumeName$ = Left$(DrvVolumeName$, pos% - 1) If Len(Trim$(DrvVolumeName$)) = 0 Then DrvVolumeName$ = "(pas de label)" 'determine l'id du disque HiWord& = GetHiWord(VolumeSN&) And &HFFFF& LoWord& = GetLoWord(VolumeSN&) And &HFFFF& HiHexStr$ = Format$(Hex(HiWord&), "0000") LoHexStr$ = Format$(Hex(LoWord&), "0000") DrvSerialNo$ = HiHexStr$ & "-" & LoHexStr$ End Sub وهذا بقية الكود : Function GetHiWord(dw As Long) As Integer If dw& And &H80000000 Then GetHiWord% = (dw& \ 65535) - 1 Else: GetHiWord% = dw& \ 65535 End If End Function Function GetLoWord(dw As Long) As Integer If dw& And &H8000& Then GetLoWord% = &H8000 Or (dw& And &H7FFF&) Else: GetLoWord% = dw& And &HFFFF& End If End Function Sub main() Dim r&, PathName$, DrvVolumeName$, DrvSerialNo$ PathName$ = "c:\" rgbGetVolumeInformationRDI PathName$, DrvVolumeName$, DrvSerialNo$ If DrvSerialNo$ <> "xxxx-xxxx" Then ms1 = MsgBox(" " & Chr$(10) & Chr$(10) & "حذار !!! برنامج غير مرخص " & Chr$(10) & Chr$(10) _ & "إن محاولة إعادة تشغيله مرة أخرى" & Chr$(10) & Chr$(10) _ & "قد يتسبب في تعطيل جهازكم" & Chr$(10) & Chr$(10) _ & "للحصول على الترخيص إتصل " & Chr$(10) & Chr$(10) _ & "بصاحب البرنامج واطلب منه الترخيص" & Chr$(10) & Chr$(10) _ , vbOKOnly + vbExclamation + vbMsgBoxRight, "تحذير") ActiveWorkbook.Save ActiveWorkbook.Close Else ms2 = MsgBox(" " & Chr$(10) & Chr$(10) & "شكرا لك على اقتناء النسخة " & Chr$(10) & Chr$(10) _ & " المرخصة من المبرمج" & Chr$(10) & Chr$(10) _ & "بالتوفيق إن شاء الله" & Chr$(10) & Chr$(10) _ , vbOKOnly + vbInformation + vbMsgBoxRight, "شكر") End If End Sub Private Sub workbook_open() Worksheets("ضع اسم الورقة هنا").Activate --------------------------جزء حماية ورقة معينة بكلمة سر ( كود ) - ---------------------------- 'protection de toutes les feuilles du document Application.ScreenUpdating = False Worksheets("ضع اسم الورقة هنا").Protect "xxxxxxx – ضع الكود الذي تريده" main End Sub -2- أما الجزء 2 فيوضع تحت ماكرو ( Modules ) سمه ما شئت وليكن مثلا : ProtictionNumDisk Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" ( _ ByVal lpRootPathName As String, _ ByVal lpVolumeNameBuffer As String, _ ByVal nVolumeNameSize As Long, _ lpVolumeSerialNumber As Long, _ lpMaximumComponentLength As Long, _ lpFileSystemFlags As Long, _ ByVal lpFileSystemNameBuffer As String, _ ByVal nFileSystemNameSize As Long) As Long حيث أن هذا الجزء هو المسؤول عن التحقق : و (xxxx-xxxx ) هو رقم القرص If DrvSerialNo$ <> "xxxx-xxxx" Then لكن المشكل عند الفرمتة ( فرمتة الجهاز ) يتغير رقم القرص ولا يعمل البرنامج لأن الرقم هو رقم البارتشين ( C ; D ; E ...... ) وليس رقم القرص الصلب الحقيقي لذا نريد ان نجد الحل ونعمل على تطويع الكود حيث يصبح يتحقق من رقم القرص الصلب الأصلي وليس البارتشين ... لأنه كما يعلم الجميع مهما فرمتنا الجهاز لن يتغير رقم القرص الصلب أما رقم البارتشين فهو يتغير حسب نسخة الويندوز والعتاد لاني جرب الطريقة التي أمامكم ولم تفلح بعدما فرمت الجهاز عن قصد فاضطررت لتغيير (xxxx-xxxx ) بالرقم الجديد لذا أرجوا من الجميع ومن لديه خبرة أن يحاول لتعم الفائدة هذا والله اعلم وأخيرا أرفق لكم ملفين للتجربة والتمحيص وفقنا الله وإياكم تجربةSerial_No.rar

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

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

بسم الله الرحمن الرحيم تحياتى للجميع الاخوة الاعزاء nse gamalin الجزيرة skyblue ادم أبوعبدالله شكرا لكم جميعا جزاكم الله كل خير فى هذا الشهر المبارك اعاده الله على امة الاسلام باليمن والبركات إن شاء الله تحياتى للجميع بسم الله الرحمن الرحيم تحياتي للجميع اليوم معنا الأداة الثانية من مجموعة:أدوات الحلول الذكية الأداة:: إكسيل كاميرا هذه الكاميرا تقوم بتصوير اى جزء من ملف الإكسيل أيضا بضغطة زر واحدة وأقوم يأستخدامها في معظم الشروح الخاصة بى . طريقة الاستخدام: قم بفتح ملف الإكسيل المراد تصوير بعض الأجزاء منه قم بتشغيل ملف الكاميرا الموجود بالمرفقات إذا لم يذهب بك إلى ملفك الأول اذهب إليه حدد مجموعة خلايا أو عدة صفحات متتالية اضغط مفتاح (1 F ) للتصوير ستجد ملف باسم ملف الإكسيل ذو نهاية ( jpg ) في نفس الفلدر الذي تعمل منه قم بفتح الملف الصورة ستجد صورة الجزء الذي قمت بتحديده حدود مساحة الصورة : يجب إلا تتعدى المساحة المختارة لتصويرها عن 500 سطر بعرض الشاشة أو ما يعادلها. تحياتي لكم جميعا ملف الإكسيل كاميرا في المرفقات Omar.rar