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

السلام عليكم و رحمة الله تعالى و بركاته أقدم لكم اليوم مرفقا يقوم بإضافة كلمة مرور جديد لملف الأكسس أو تعديل كلمة مرور قديمة أو حذفها نهائيا. 1- لإضاف كلمة مرور جديدة يجب ترك مربع كلمة السر القديمة فارغا و كتابة الكلمة الجديدة فقط ثم الضغط على زر الأمر 2- لتعديل كلمة المرور نكتب الكلمة القديمة و نكتب الكلمة الجديدة ثم الضغط على زر الأمر 1- لحذف كلمة المرور نكتب الكلمة القديمة ونترك مربع كلمة السر الجديدة فارغا ثم الضغط على زر الأمر و قد استخدمة هذه الوحدة النمطية: Public Function ChangePassword(path_file As String, Old_Password As String, New_Passwod As String) On Error GoTo err Dim odb As DAO.Database Set odb = DBEngine.OpenDatabase(path_file, True, False, ";pwd=" & Old_Password) odb.NewPassword Old_Password, New_Passwod MsgBox "لقد تم تغيير كلمة المرور بنجاح" fin: Set odb = Nothing Exit Function err: Select Case err.Number Case 3031 MsgBox "كلمة المرور غير صحيحة", vbCritical, "Sécurité" Case Else MsgBox err.Description, vbCritical, "Erreur No." & err.Number End Select Resume fin End Function و قمت بإستدعائها من خلال هذا الكود: Call ChangePassword(Me.txtpath1, Nz(Me.OldMot, ""), Nz(Me.NewMot, "")) تغيير كلمة السر برمجيا.rar

تفضل أيها العبد الفقير المسكين الطيب ليس لدي الوقت للابداع والتصميم لكن هذا مثال بسيط واعتقد انك ستصل به الى ما تريد Consumable Material Check List waz.accdb

تفضل لك ما طلبت الحسابات1.xlsx

كيف نلزم المستخدم بالكتابة 1-بأحرف صغيرة فقط 2-أو احرف كبيرة فقط 3-او اختيار (كبيرة أو صغيرة) حصراً للمزيد هذا الملف Upper_Lower.xlsx

اتعرف ما يزيد العمل جمالا اخي العزيز جعفر وجودك هو ما يزين أي مشاركة في هذا الصرح الرائع تحياتي لشخصك الكريم

نعم يا غالي تخطي كلمة المرور يعني إنتهاك للحقوق

وعليكم السلام 🙂 كلمة سر البرنامج او VBA ؟ صيغة البرنامج mdb او accdb ؟ هل البرنامج جزء واحد او مقسم الى جزئين واجهة وجداول ، واذا مقسم ، هل تريد كلمة سر الواجهة او الجداول ؟ جعفر

احنا في الهوى سوى ، بس كل يصل ليلاه بطريقته ❤️ جعفر

أستاذنا ابا جودى مرفق ملف إكسيل بنفس تصميم الصورة التى أرفقتها ولكنى لا أعلم كيف أطابقها ببيانات النموذج فالمسميات مختلفه رجاء التوضيح Mr.AbaJudy.xlsx

أحسنت استاذ سليم عمل ممتاز جعله الله فى ميزان حسناتك

بارك الله فيك وزادك الله من فضله

تفضل تم تغيير معادلتك نهائياً فهى لا تعمل المشتريات1.xlsx

جزاك الله خير الثواب وبارك الله فيك استاذ مجدى

بارك الله فيك استاذ جعفر ونتمنى لهم جميعا النجاح والتفوق دائما اختيار موفق أعانهما الله على تحمل المسؤليات الجديدة

جزاك الله خير الثواب وبارك الله فيك استاذ مجدى

بارك الله فيك وزادك الله من فضله

وعليكم السلام عليك بتحويل عمود التواريخ الى نص قبل كتابة التواريخ به وبالتالى يحافظ لك على شكل التاريخ الذى تريد عند الكتابة فيحفظ اى شكل تكتبه واذا لم توفق فى ذلك فعليك برفع الملف -فلابد دائما من رفع ملف مدعوم بشرح كافى عن المطلوب

حاجاتك تعجبنا كثيرا أخي جمال يالله أعصر دماغك يا مبدع

السلام عليكم جرب المرفق دقق على عمل الفورم ان وجدت ملاحظات ارفقها وسيتم تعديلها انشاء الله في امان الله استعلام عن طريق الاسم 1.xlsm

لا افهم ما الغاية من هذا الشيء لأن الصفحة الثّانية بعد نسخ المعادلات تصبح نسخة طبق الاصل عن الصفحة "بيان" على كل حال اليك هذا الكود للنسخ مع المعادلات Option Explicit Sub FILL_DATA_WITH_FORMULAS() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim R#, i#, m#: m = 3 Dim Maj As Worksheet, Sal As Worksheet Set Maj = Sheets("مجاني") Set Sal = Sheets("SALIM") Sal.Range("A2").CurrentRegion.Offset(1).Clear R = Maj.Cells(Rows.Count, "Z").End(3).Row For i = 2 To R If Maj.Cells(i, "Z") <> vbNullString Then Maj.Cells(i, 1).Resize(, 26).Copy Sal.Cells(m, 1).PasteSpecial (11) m = m + 1 End If Next 'Sal.Columns.AutoFit Sal.Range("A3").CurrentRegion.Borders.LineStyle = 1 With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub

عمل جميل اخي ابو الكرم 🙂 جعفر

ويعمل بحروف عربية كذلك 🙂

عفوا اخوي كاسر ، كلامك صحيح 🙂

الملف كاملاً بواسطة الكود ما عليك الا ان تضغط الزر PRESS ME PLEAS CODE Sub get_val() Dim R#, My_Sh As Worksheet Set My_Sh = Sheets("Sheet1") R = My_Sh.Cells(Rows.Count, 3).End(3).Row With My_Sh.Range("E4").Resize(R - 3) .Resize(, 4).ClearContents .Formula = "=IF(D4<100,D4,100)" .Offset(, 1).Formula = _ "=IF(D4<=100,"""",IF(AND(D4>100,D4<200),D4-100,100))" .Offset(, 2).Formula = _ "=IF(AND(SUM(E4:F4)=200,D4>200),D4-SUM(E4:F4),"""")" .Offset(, 3).Formula = _ "=SUMPRODUCT(E4:G4,$L$4:$N$4)" .Resize(, 4).Value = .Resize(, 4).Value End With End Sub FILE INCLUDED Fatura_new_VBA.xlsm

اليوم صالح حمادي فتح موضوع بهذا الشان تغير كلمه السر وفي برامج تعطيك كلمه السر برنامج يعطي كلمه السر حق mdb اي اذا صيغطته accdb رجعها mdb

تأخرت لأني كنت ابحث عن الموضوع 🙂 تفضل ، مادام واجهة ، فالامر سهل 🙂 جعفر

للأسف ما عندي تجربة في مثل الشيء ، وبعد البحث اخبرتك 🙂 وقوانين المنتدى تقول: 1. يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية لا تسمح بأن نفك كلمة سر برنامج (هذا اذا كنا قادرين اصلا) ، ولكن الانترنت مليان مثل هذه الاسئلة 🙂 جعفر

تم توزيع الاشطر (بواسطة المعادلات) على فكرة اذا كنت تريد توزيع الاشطر اولاً فأنت لست بحاجة للماكرو كما في الورقة salim من هذا الملف Fatura_new.xlsm

انا عملت اللي ممكن اقدر عليه في الكود ، جربه واخبرنا لو سمحت Function IsAutoNumber2() 'DoCmd.SetWarnings False Dim n, f, D, E, L, t, h, G As Integer Dim rst As DAO.Recordset Dim bb As Integer ' Dim i As Integer, RC As Integer ' Set rst = CurrentDb.OpenRecordset("SELECT * FROM [اقمشة]") ' rst.MoveLast: rst.MoveFirst ' RC = rst.RecordCount ' For i = 1 To RC Set rst = CurrentDb.OpenRecordset("SELECT komash, qunt4 FROM [اقمشة]") Do While Not rst.EOF rst.Edit n = Nz(DSum("[quntt]", "Data", "komash='" & rst!komash & "'"), 0) f = Nz(DSum("[quntt1]", "Data", "komash1='" & rst!komash & "'"), 0) D = Nz(DSum("[quntt2]", "Data", "komash2='" & rst!komash & "'"), 0) E = Nz(DSum("[quntt3]", "Data", "komash3='" & rst!komash & "'"), 0) L = Nz(DSum("[quntt4]", "Data", "komash4='" & rst!komash & "'"), 0) t = Nz(DSum("[quntt5]", "Data", "komash5='" & rst!komash & "'"), 0) h = Nz(DSum("[quntt6]", "Data", "komash6='" & rst!komash & "'"), 0) G = Nz(DSum("[quntt7]", "Data", "komash7='" & rst!komash & "'"), 0) rst("qunt4").Value = n + f + D + E + L + t + h + G rst.Update rst.MoveNext Loop ' Next i rst.Close: Set rst = Nothing MsgBox " تم تعديل السجلات في الجدول بنجاح ", vbInformation, "تنبيه" 'DoCmd.SetWarnings True End Function جعفر

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

السلام عليكم اذهب خيارات الاكسل ثم مركز التوثيق ثم اعدادات مركز التوثيق ثم خيارات الخصوصية زيل المؤشر اذا محفز

لا وجه للمقارنة أستاذنا jjafferr .. فلا فتوى ومالك بالمدينة .. 😍

اما انا فسؤالي اكسس وغير عن سؤال الاستاذ عصام 🙂 هل يبقى الجزء العلوي فارغ ، بعدد 10 اسطر ، او فيه معلومات من جدول ما ؟ والجزء السفلي ، هل دائما ثابت على 11 سطر ، واذا زادت السجلات عن 11 فماذا تفعل؟ جعفر

جرب هذا الملف الكود Option Explicit Function how_to_pay(Myfact#, n1#, n2#, n3#) As Double '''''''''''''''''''''''''''''''''''''''''' Dim How_Many# Select Case Myfact Case Is <= 100 How_Many = Myfact * n1 ' a Case Is <= 200 How_Many = (100 * n1) + (Myfact - 100) * n2 ' a+b Case Is > 200 How_Many = (100 * n1) + (100 * n2) + (Myfact - 200) * n3 'a+c+d End Select how_to_pay = How_Many '''''''''''''''''''''''''''''''''''''''' End Function Fatura.xlsm

جرب المرفق طالما بتستخدم عمليات حسابية اجعل الحقل الرقمي مزدوج والمنازل العشرية 2 ولوجود كسور استخدم دالة التقريب ملخص الفاتورة.accdb

ضع الكود في الليست بوكس Private Sub ListBox1_Click() TextBox1.Value = ListBox1.Column(0) TextBox2.Value = ListBox1.Column(1) TextBox3.Value = ListBox1.Column(2) TextBox4.Value = ListBox1.Column(3) TextBox5.Value = ListBox1.Column(4) TextBox6.Value = ListBox1.Column(5) TextBox7.Value = ListBox1.Column(6) End Sub

ولا يهمك 🙂 اذا كان البرنامج بصيغة mdb ، فيمكنك تعطيل الشفت ، وابحث في المنتدى عن هذا الخيار ، فالمنتدى مليان مواضيع بهذا الموضوع 🙂 جعفر

ستضع ايضا هذا الكود اسفل الكود الاول "", "{ Application.OnKey "^{s وذلك لمنع الحفظ باسم من لوحة المفاتيح

السلام عليكم ضع هذا الكود في حدث ال (workbook open) (Application.ExecuteExcel4Macro " show.toolbar(""Ribbon"",False) هذا سيجعل ال ribbon تختفي عند فتح الملف

تم التعديل على الماكرو كما تريد My_book (1).xlsm

السلام عليكم صباح الخير اختي ام حمزه الرجاء مراجعه هادا الموضوع لعله يكون طلبك هنا

جرب هذا الكود النتيجة في شيت SALIM Option Explicit Sub FILL_DATA() Dim R#, i#, m#: m = 2 Dim Maj As Worksheet, Sal As Worksheet Set Maj = Sheets("مجاني") Set Sal = Sheets("SALIM") Sal.Range("A2", Range("A1").End(4)).ClearContents R = Maj.Cells(Rows.Count, "Z").End(3).Row For i = 2 To R If Maj.Cells(i, "Z") <> vbNullString Then Sal.Cells(m, 1) = Maj.Cells(i, "Z") m = m + 1 End If Next End Sub الملف مرفق My_book.xlsm

وعليكم السلام 🙂 البرامج التي بصيغة mde. و accde. مقفله ، فلا تستطيع ان ترى الكود ، نعم هناك طريقة تفتح فيها النماذج ، وتستطيع ان تغير (ولا تحذف شيء ابدا) ، ولكن لن تستطيع عمل تغيير كود ، طبعا تقدر تعمل ماكرو للحدث الجديد. بس من الواضح انك لم تعمل البرنامج ، لذا الافضل ان ترجع الى المبرمج لعمل التغييرات المطلوبة 🙂 جعفر

أحسنت استاذ مجدى عمل رائع ,جعله الله فى ميزان حسناتك وغفر لك

فورم ادخال البيانات والتأكد منها للادخال الفيديو

أحسنت استاذ مجدى بارك الله فيك

جرب الملف المرفق بعد إضافة دالة IF على المعادلة.... الغياب دالة البحث.xlsm

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

أعتذر عن مشاركتى لمجرد المشاركة بالتوفيق

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