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

السلام عليكم 🙂 رجاء مراجعة موضوع النسخة 2 من هنا : واجهة هذه النسخة: البرنامج يقوم بهذه الخطوات التي يوصي بها المحترفين (كما هو موضح في الصورة اعلاه) ، طريقة العمل: 1. اختار ملف اكسس ، 2. اذا الملف محمي بكلمة سر ، فيمكن كتابته في المربع المخصص ، حيث سيتم حفظه في ذاكرة الكمبيوتر ، والتي يجب عليك ان تدخلها يدويا للقيام بالخطوات 2 و 3 لمرة واحدة ، بينما البرنامج سيدخلها تلقائيا للخطوات التالية ، 3. يجب ان تمسك مفتاح الشفت ، ثم تضغط على زر Decompile ، ولا تترك الزر إلا لما ينتهي البرنامج من عمله ، عندما نرى الخطوات 8 و 9 🙂 هذه النسخة اسرع من النسخة السابقة ، وافضل 🙂 جعفر Decompile_3.zip

السلام عليكم 🙂 مثال مشابه جعفر

حياكم الله 🙂 لما انتهي من برنامج ، او عمل تعديل على برنامج ، وقبل ان ارسله الى الزبون ، فاقوم بتمريره عبر هذا البرنامج ، والذي يضمن لي ان البرنامج اصبح في كامل لياقته ، وهذه العملية إجبارية لي ، وليست اختيارية 🙂 جعفر

السلام عليكم 🙂 النسخة الثالثة من البرنامج 🙂 جعفر

السلام عليكم ورحمة الله وبركاته بعد إذن استاذنا الفاضل سليم حاصبيا هذا نفس الحل ولكن بالمعادلات HOW_many_letters.xlsm

جزيل الشكر اخ @خالد سيسكو ساعدتني كثيرا وهذا الي اريده انا ربي يوفقك ويحفظلك احبابك

شكراً استاذ محسن و لي انا بهذا الشأن هذا الماكرو (عسى ان ينال الإعجاب) Option Explicit Sub S_H_Test_NEW() Dim D As Worksheet: Set D = Sheets("Data") Dim M As Worksheet: Set M = Sheets("المطلوب") Dim ARR(): ARR = Array("S", "G", "C", "H") Dim Obj As Object, i%, Chek%, t% Set Obj = CreateObject("Scripting.Dictionary") M.Range("K2").CurrentRegion.ClearContents i = 2 Do Until D.Range("F" & i) = vbNullString For t = 1 To 4 Chek = Chek + (UCase(M.Cells(2, t)) = _ UCase(D.Cells(i, ARR(t - 1)))) Next If Chek = -4 Then _ Obj.Add i, D.Cells(i, "F") i = i + 1: Chek = 0 Loop If Obj.Count Then _ M.Cells(2, "k").Resize(Obj.Count) = _ Application.Transpose(Obj.items) Set Obj = Nothing: Set D = Nothing: Set M = Nothing Erase ARR End Sub الملف من جديد MY_search_MD_SH.xlsm

عليكم السلام تفضل يا استاذى الفاضل على قد ما فهمت طلبك وتقدر تزود اى شيتات تحتاجها وهيتم تحميلها على الكومبوبوكس اوتوماتيكا لو فى تغيير او شئ مختلف عرفنى وشكرا. ttt (1) (1).xlsm

برنامج شئون العاملين الباسوورد 2545 برنامج شئون العاملين.rar

برنامج بسيط للحضور والانصراف ان شاء الله يعجبكم الباسوورد 2545 برنامج الحضور والانصراف.rar

الاخوة الافاضل اود معرفة ما هي المشكلة لدي في نموذج systempass بحيث انني عندما اختار اسم المستخدم وكلمة المرور له لا يدخل على النموذج الرئيسي واشكر لكم تعاونكم مثال.rar

احد المؤسسات التي تستعمل احد برامجي ، عندها 16 مستخدم ، وحوالي 2200 عملية تعامل مع البيانات يوميا ، من سجلات جديدة ، او تحديث او حذف ، او تصفح ، واكثر من مليون ونصف سجل بين مختلف جداول البرنامج ، لهذا السبب ، مافي مجال إلا ان يكون البرنامج في كامل لياقته 🙂 جعفر

السلام عليكم ورحمة الله استخدم هذا الكود Sub SelCase() For i = 7 To 1000 If Not IsNumeric(Cells(i, "EU")) Then Cells(i, "DS") = Cells(i, "EU") ElseIf Cells(i, "FO") = 0 Then Cells(i, "DS") = "ناجح" ElseIf Cells(i, "FO") <= 2 Then Cells(i, "DS") = "دور ثان" Else Cells(i, "DS") = "راسب" End If Next End Sub

هل اسم ملف الاكسل هو نفس الاسم الموجود في الصورة .......

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

اخي العزيز لكي اسهل عليك حل مشكلتك . ولكي يتسنى للاساتذة مساعدتك . يفضل ان يكون سؤالك عن مشكلة واحدة في كل مشاركة من جنابك الكريم فلو لاحظت عنوان مشاركتك الحالية لقد ابتعدت عنها كثيراً . انا عن نفسي عندما اصمم فورم وتواجهني مشكلة مقابل كل مشكلة اعمل مشاركة جديدة وذلك مراعاة لوقت الاساتذة ولانشغالهم في امورهم الخاصة . اما في مايخص طلبك الاخير والذي تريد الفورم يعمل على جميع الصفحات . انا ارى ان الاكواد مصممة جميعها على شيت 1 وحاولت ان اساعدك وتمكنت من جعل زر الاضافة ينزل البيانات للشيت المختار الا ان حصل تعارض بين الاكواد .. لذا ارى ان تعمل زر ترحيل وليس زر ادخال وهذا يتطلب منك مشاركة جديد اطلب فيها عمل زر ترحيل لصفحة معينة .. عذراً على الطالة . تحياتي لك اخي العزيز

تفضل بيانات الموظفين.xlsm

جرب هذا الرابط ، فيه مجموعة طرق ، من خبير 🙂 https://accessexperts.com/blog/2011/03/24/sql-server-connections-strings-for-microsoft-access/ جعفر

تفضل على حسب ما فهمت منك Work.xlsm

اخى ابو البشر المثال بالاعلى بجوار السلام عليكم وهتضحك اكتر بقى المثال مش شغال هههههههههههههههههههههه

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

اعتذر اخي لتأخري في الرد جرب المرفق عد الكومبوبكس الممتلئة.xlsm

لم انتبه للمثال في بداية الموضوع

اخى عبداللطيف على ما اعتقد انك رفعت المثال قبل الحفظ حيث انه ليس هناك اى تغيير حدث اخى @رعد داود ركز معى بارك الله فيك وجزاك الله خيرا فى يد العون والمحاوله لاخوانك توضيح لكى تعم الفائده DLookup("[user]", "Pass", "[Pass]= [n2] and [user]= [مربع_تحرير_وسرد62]") المفروض انك عاوز تجيب الباس الخاص وتختبره هل هو ده ام لا لكن انت عكست ثم قمت بالاختبار على اساس عدم مساوه المتغير بصفر Dim X X = Nz(DLookup("[user]", "Pass", "[Pass]= [n2] and [user]= [مربع_تحرير_وسرد62]"), 0) If X <> 0 Then UserName = X DoCmd.OpenForm "main" DoCmd.close acForm, "systempass" Else MsgBox "كلمة المرور غير صحيحة", vbInformation, "رسالة خطأ" DoCmd.OpenForm "changepass" والله اعلى واعلم تقبلوا تحياتى وتمنياتى لكم وللجميع بالتوفيق

احسنت اخى رعد بجلب الباس والمستخدم بداله DLookup DLookup("[user]", "Pass", "[Pass]= [n2] and [user]= [مربع_تحرير_وسرد62]") واليك تغيير بسيط بالكود الاصلى مشاركه مع اخوانى الافاضل If (Password = n2) And (UserName = مربع_تحرير_وسرد62.Column(1)) Then وارفق لك مثال اخر خاص بكلمات المرور من مشاركه لاخى @خالد سيسكو باستخدام داله المقارنه StrComp وده رابط للاستفاده تقبلوا تحياتى وتمنياتى لكم وللجميع بالتوفيق مثال.rar اظهار كلمة المرور.rar

تفضل ضع مجلد صور الموظفين في القسم D يمكن تغيره في هذا السطر fName = "D:\صور الموظفين\" & r & ".jpg" بيانات الموظفين - مع صورته.xlsm صور الموظفين.rar

جرب هذا الملف الصفحيتن Sheet1 & Salim HOW_many_letters.xlsm

جرب هذا التغيير مثال.rar

كود مبدع من بريفيسور مبدع احسنت استادنا سليم

جرب هذا الملف FInd_common_numbers.xlsm

دائما مبدع ونتعلم منكم الكثير زادكم الله علما ونفعكم بما علمك

يعمل بشكل ممتاز شكر استاذ ( أحمد الفلاحجي ) >>>> تغير text.n الى n.text جزاك الله خيرا filtertext2.rar

اتفضل ان شاء الله يظبط معك غير text لاسم حقل النص لديك If Not IsNull(text.n) Then Me.[conform_zabon].Form.Filter = " [text] ='" & text.n & "'" Me.[conform_zabon].Form.FilterOn = True Else: IsNull (text.n) Me.conform_zabon.Form.FilterOn = False End If اخبرنا بالنتيجه بالتوفيق ان شاء الله

الضغط على ctrl+f3 والتعديل على نطاق الخلايا تم تسميته

الكود واحد فالنموذجين والاشاره لحقل التكست ولكن فالنموذج الاول قمت بالتعديل على عجاله لحقل النص الغير المنضم فالنموذج الاول فقط Dim f, k As Date Dim j As String Dim s As Long If DCount("[no]", "hesab") > 0 Then f = DMax("datee", "hesab") If Year(datee) > Year(f) Then t2 = 1 Else j = "Year(datee) = " & Year(Me.Td) t2 = DMax("[no]", "hesab", j) + 1 End If Else t2 = 1 End If الكود بيشوف اذا كان حقل ترقيم السند اكبر من 0 يقوم بجلب اعلى تاريخ وحجزها بالمتغير ثم نختبر السنه هل هى اكبر من السنه التى بالحقل Td ان كان اكبر فيعطي حقل الترقيم رقم 1 وان كان مساوى يجلب اعلى رقم فحقل ترقيم السند ويزود عليه 1 والا فيعطيه رقم 1 وهذا اول سجل بالجدول ياريت اكون قدرت اشرحلك وابسطلك المعلومه واعذرنى عالتقصير تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق

البرنامج بعد اضافة الصيانات برنامج السيارات.rar

تفضل بعد اذن الأستاذ فايز problem sum if green erorr2.xls

بارك الله فيك اخى الكريم . كل ما اعرفه عن الاكسل بفضل هذا المنتدى والعمالقه الموجوده فيه .

تم التعديل على الملف ليعمل كما تريد لا حاجة لادراج الترقيم (اكسل يفعلها أوتوماتيكياً) يمكنك التحرك داخل الشيت حتى ولو كان اليوزر ظاهراً Sort_Please.xlsm

جرب هذا الملف MY_test (4).xlsx

لأني كسلان اذا اردت استعمالها ، فيجب ان يتغير الكود الى: Option Compare Database Option explicit Function Seperate_Digits(T as string) as string dim i as integer dim C as string dim Which_Letter as string 'T = Text From Query If Len(T & "") = 0 Then Seperate_Digits = "" Exit Function End If For i = 1 To Len(T) 'the ascii number of each number C = Asc(Mid(T, i, 1)) 'ascii numbers we want '46= . '47= / '48= 0 '49= 1 '50= 2 '51= 3 '52= 4 '53= 5 '54= 6 '55= 7 '56= 8 '57= 9 Select Case C Case 46, 48 To 57 Which_Letter = Which_Letter & Mid(T, i, 1) Case 47 Which_Letter = "" End Select Next i Seperate_Digits = Which_Letter End Function جعفر جعفر

تفضل ، هذه الوحدة النمطية الجديدة 1. نحسب طول المعلومة ، اذا كانت صفر ، فلا ندخل في بقية المعادلات ، 2. واذا لقينا Case 47 ، فنحذف كل ما كان قبله ""=Which_Letter ، ونبدأ البحث عن الارقام من جديد Function Seperate_Digits(T) 'T = Text From Query If Len(T & "") = 0 Then Seperate_Digits = "" Exit Function End If For i = 1 To Len(T) 'the ascii number of each number C = Asc(Mid(T, i, 1)) 'ascii numbers we want '46= . '47= / '48= 0 '49= 1 '50= 2 '51= 3 '52= 4 '53= 5 '54= 6 '55= 7 '56= 8 '57= 9 Select Case C Case 46, 48 To 57 Which_Letter = Which_Letter & Mid(T, i, 1) Case 47 Which_Letter = "" End Select Next i Seperate_Digits = Which_Letter End Function جعفر