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

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

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

السلام عليكم في الكثير من الأحيان نحتاج إلى معرف مصدر اختصارات سطح المكتب أو إلى معرفة هل هذا البرنامج لديه اختصار على سطح المكتب أم لا؟ نستطيع استخراج مصدر اختصارات سطح المكتب و ملفها من خلال هذا الكود: Dim strFolder As String Dim strDesktop As String Dim typefiche As String Dim strtxt As String typefiche = "\*.lnk" strDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") strFolder = Dir(strDesktop & typefiche, vbDirectory) Do While strFolder <> "" If Not (strFolder = "." Or strFolder = "..") Then strtxt = "Full Path: " & CreateObject("WScript.Shell").CreateShortcut(strDesktop & "\" & strFolder).TargetPath & vbCrLf strtxt = strtxt & "Path Folder: " & CreateObject("WScript.Shell").CreateShortcut(strDesktop & "\" & strFolder).WorkingDirectory & vbCrLf MsgBox strtxt End If strFolder = Dir() Loop مصدر اختصارات من سطح المكتب.rar

الف مبروك مع الشكر و التقدير و اطيب الامنيات و الي الامام دائما 🌹

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

اخوتي واساتذتي الكرام .. أضع بين أيديكم البرنامج مفتوح المصدر البرنامج مكون من عدة اجزاء الجزء الاول وهو البرنامج الرئيسي protection_trial وهو المسؤول عن قراءة مكونات جهاز العميل (قراءة سيريال الـ UUID و اسم المعالج) لتوليد رقم نسخة فريد خاص بجهاز العميل يقوم العميل بارساله الى المبرمج. ملاحظة1: في البداية وقبل ارسال البرنامج لاي عميل قم برفع المستند النصي المرفق Active1.txt الى موقع الـ dropbox واعمل للمستند مشاركة واستخرج من رابط المشاركة رمز مشابه لهذا الرمز (n702324j1aclxel) واستبدله في البرنامج لديك If CheckNetFile("https://dl.dropboxusercontent.com/s/n702324j1aclxel/active1.txt?dl=0") = True Then MyString = Decrypt(RTrim(LTrim(GetFromWebpage("https://dl.dropboxusercontent.com/s/n702324j1aclxel/active1.txt?dl=0")))) If MyString = "" Then MyString = Decrypt(RTrim(LTrim(ReadURLFile("https://dl.dropboxusercontent.com/s/n702324j1aclxel/active1.txt?dl=0")))) الخطوة السابقة تفعلها للمرة الاولى فقط. الجزء الثاني من البرنامج وهو برنامج التشفير encrept_data وهو خاص بالمبرمج حيث يقوم المبرمج بأخذ رقم النسخة السابق من العميل ووضعه في المستند النصي المرفق مع برنامج التشفير active1 -original.txt مع تحديد تاريخ بداية فترة التفعيل ونهايتها كما هو موضح داخل المستند ومن ثم فتح برنامج التشفير ومة خلال النموذج الاول frm اضغط مباشرة على كلمة تشفير النص وذلك لتوليد مستند نصي آخر اسمه Active1.txt فيه تشفير لبيانات المستند النصي السابق .. قم برفع المستند النصي Active1.txt على موقع الـ dropbox بدون حذف الملف القديم الموجود على الموقع ( فقط ارفعه على نفس المكان ليقوم الموقع باستبدال الملف القديم بالجديد تلقائياً بدون تغيير رابط المشاركة) في كل مرة تقوم باضافة عميل جديد كل ماعليك القيام به هو فتح مستند النص active1 -original.txt ثم قم باضافة رقم نسخة العميل وتاريخ فترة تفعيل البرنامج ومن ثم تشغيل برنامج التشفير encrept_data ومن ثم رفع المستند النصي الناتج Active1.txt الى موقع الـ dropbox مباشرة في نفس مكان الملف القديم مع مراعات عدم حذف القديم لكي لاتفقد رابط المشاركة وهذا أمر هام جداً يرجى الانتباه له تحياتي encrept_data.zip protection_trial.mdb

تهنئة من القلب والف مبروك نسأل الله لكم التوفيق والعون

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

اخي @qathi تفضل DatabaseRestartV1.2.accdb DatabaseRestartV1.2.mdb المصدر : http://blog.nkadesign.com/2008/05/06/ms-access-restarting-the-database-programmatically/

فورم بحث واضافة وتعديل وحذف وترحيل وطباعة بطريقتين الفيديو الاول بحث الفيديو

شكراً جزيلاً لك أستاذ محمد ياسين على تهنئتك الجميلة... شرف لي ان انضم إليكم .. وفقكم الله

ألف مبروك للخبيرين يستاهلو أكثر ننتظر منكم المزيد إن شاء الله

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

جزاكم الله خيرا اخواني الكرام وارجو من الله العلي القدير ان نكون عند حسن الظن وأود ان اذكر نفسي واخواني يأن الله سبحانه وتعالى لم يأمر نبيه صلى الله عليه وسلم بطلب الزيادة الا في العلم فقال سبحانه وتعالى " وقل رب زدني علماً" فنرجو من الله ان يزيدنا علماً وأن ينفع بنا وأن يجعلنا هداة مهتدين تحياتي

وعليكم السلام ورحمة الله وبركاته جزاك الله خيرا استاذنا جعفر لحسن ظنك بي ووالله انه لشرف كبير وارجو من الله ان يوفق ويعين الجميع لما يحب ويرضى تحياتي حياك الله استاذي الفاضل @kha9009lid واسأل الله ان يزيدك من فضله وعلمه تحياتي

وعليكم السلام 🙂 حلين : 1. يجب ان توضح في الكود: dim db as dao.database 2. يجب ان لا تستعمل كلمة Database كإسم المشروع هنا : . جعفر

وعليكم السلام 🙂 في الواقع هذه ميزات الاكسس ، عندك اكثر من طريقة لعمل اي شيء 🙂 شكرا لك 🙂 جعفر

مسابقة دينية للاجابة عليها من اربع خيارات الفيديو

الاخوة الكرام السلام عليكم ورحمة الله وبركاته مرفق مثال بسيط لعمل تصفية XFilter.rar دمتم بكل خير تحياتي

بالتوفيق اخي الكريم ولك جزيل الشكر تحياتي

بارك الله فيك اخي الكريم فقط احذف المعيار التالي من الاستعلام [forms]![Data01]![ItemBarcode] prov - Copy.rar تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل انظر المرفق في تقرير items تم وضع معيار لكود الصنف والتاريخ prov - Copy.rar تحياتي

تفضل اخي الكريم تحياتي

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

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

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

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

أشكرك أستاذي @sandanet على هذا المثال .. هكذا تعودتنا بعطائك وخيرك الذي لا ينقطع بارك الله فيك .. وجزاك الله عني خير

السلام عليكم ورحمة الله تم تطويع وتكييف كود طباعة إلى PDF من المنتدى (لأحد الإخوة الكرام لا أتذكره) على ملفك حتى يتم طباعة كل الشهادات (كل شهادة في صفحة A4 -باتجاه عرضي Landscape-) في ملف PDF بالتسمية "الشهادات.pdf" في مجلد backup يتم إنشاؤه تلقائيا في نفس موقع الملف الذي يتم العمل عليه... أرجو أن تفي هذه التعديلات الغرض المطلوب... بن علية حاجي المصنف2.xlsm

ترليون مبروك وأعانكم الله على حمل المسؤولية

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

الف مبروك للأساتذة الأفاضل اسأل الله لكم التوفيق والسداد والرشاد أنتم فخر لنا وللمنتدى وتعلمنا منكما كثيراً فهنيئا لنا وللمنتدى بكم .

أستاذي الفاضل @محمدنجار شكراً لك على التهنئة وان شاء الله اكون عند حسن ظنكم .. تم تفعيل نسختك

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

السلام عليكم ActiveSheet.ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=Environ("USERPROFILE") & "\Desktop\" & ID & ".Pdf", _ IgnorePrintAreas:=False, _ Openafterpublish:=False

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

استاذ @سلمان الشهراني تم تفعيل نسختك

شكرا لكما معلمينا الأفاضل على الإفادة جزيتم خيرا

ماشاء الله تبارك الله ابداع

بخصوص مشكلة الاستعلام سبق وضعنا الحل بمعية استاذنا الفاضل جعفر

انا لا افهم ما لزوم الحلقات التكرارية في الكود وهي التي تجعل الملف ثقيلاُ (2000 حلقة) يكفي هذا الماكرو Sub SALIM() Application.ScreenUpdating = False Dim ws As Worksheet Set ws = Worksheets("min") Dim Ro_D%, Ro_A% Ro_D = Cells(Rows.Count, "D").End(3).Row Ro_A = Cells(Rows.Count, "A").End(3).Row With ws .Range("g:f").ClearContents .Cells(2, "f").Resize(Ro_D - 1).Formula = _ "=INDEX($J$2:$J$2000,MATCH(D2,$I$2:$I$2000,0))" .Cells(2, "G").Resize(Ro_A - 1).Formula = _ "=INDEX($Q$1:$Q$6,MATCH(A2,$P$1:$P$6,0))" .Range("g:f").Value = .Range("g:f").Value End With Application.ScreenUpdating = True End Sub

وعليكم السلام-بالله عليكم انتبه لهذا الموضوع جدا فقد نبهنا فى العديد من المرات عليكم بإستخدام خاصية البحث فى المنتدى قبل رفع المشاركات فالمنتدى به كنوز وحتى تتفرغ الأساتذة للإجابة على اسئلة مختلفة لم ترد بالمنتدى لعدم اهدار الوقت تفضل به طلبك https://www.officena.net/ib/topic/98306-ترحيل-خليه-محدده-بدون-التنسيق-مع-مسح-المرحل/

أمر بسيط جداً بواسطة التعديل على الماكرو في الاسطر مابين علامات الـــ+ ++++ ليبدو الماكرو هكذا Option Explicit Sub get_moulahaza() Dim Dic_Name As Object Dim Dic As Object Dim i%, Ro%, ky Ro = Cells(Rows.Count, 2).End(3).Row '+++++++++++++++++++++++++++++++++++++++++ Range("j4").CurrentRegion.Offset(2).ClearContents '+++++++++++++++++++++++++++++++++++++++++ Set Dic_Name = CreateObject("Scripting.Dictionary") Set Dic = CreateObject("Scripting.Dictionary") '============================= '++++++++++++++++++++++++++++++++++ For i = 2 To Ro Dic_Name(Cells(i, 2).Value) = Cells(i, 1).Value Next '++++++++++++++++++++++++++++++++++ '============================= For Each ky In Dic_Name.Keys For i = 2 To Ro If Cells(i, 4) <> "حاضر" And Cells(i, 2) = ky Then If Not Dic.Exists(Cells(i, 2).Value) Then Dic.Add Cells(i, 2).Value, _ Cells(i, 4) & " " & Cells(i, 3) Else Dic(Cells(i, 2).Value) = _ Dic(Cells(i, 2).Value) & " * " & _ Cells(i, 4).Value & " " & Cells(i, 3) End If End If Next i Next ky With Dic Cells(4, "K").Resize(.Count) = _ Application.Transpose(.Keys) Cells(4, "L").Resize(.Count) = _ Application.Transpose(.items) End With '++++++++++++++++++++++++++++++++++++++++++ Cells(4, "J").Resize(Dic_Name.Count) = _ Application.Transpose(Dic_Name.items) '++++++++++++++++++++++++++++++++++++++++++ Set Dic_Name = Nothing: Set Dic = Nothing End Sub الملف من جديد Exampl_moulahaza_new.xlsm

السلام عليكم فهمت عليك تفضل جرب المرفق غياب_A5 مع الغياب بعذر.xlsm

ماشاء الله عليك استاذ @kaser906 مثال جميل ورائع .. اخي الـ @qathi هل شاهدت مثال الاخ الكاسر؟

اخى ووالدى العزيز ابويوسف نورت قسم الاكسيس واسال الله ان يشفى لك ولدك شفاء لا يغادر سقما

الف شكر اخ على

السلام عليكم الكود التالي كود يقرب الاعداد باستخدام الدالة Math.Round انا اريد الدالة التي تقرب العدر للعدر الاعلى يعني لوعندي 2.1 يرقيه للعدد 3 كود باستخدام محرر فيجوال بالاكسل Me.TextBox3.Text = Math.Round(Val(TextBox1.Text) - Val(TextBox2.Text)) استخدمت RoundUP وما كان في نتيجه

اليك الملف ترحيل الفاتورة فاتورة جديدة7.xls

وعليكم السلام-على الرغم ان هذه المشاركة مخالفة لتعاليم ومبادىذ المنتدى -لأننا تقوم بالتنيه مئات المرات انه لا تكتمل المشاركة الا برفع ملف مدعوم بشرح كافى عن المطلوب والا سوف تحذف مشاركتك لأن هذا يعتبر اهدار للوقت كما انه لا يمكن العمل دائما على التخمين ولكن سأخبرك عن طلبك فلو افترضنا ان الرقم القومى موجود بالخلية A2 وتريد الفصل مثلا بالخلية B2 فتكون المعادلة كالتالى =RIGHT(A2,7)