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

السلام عليكم Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 46 Then ' your msg exit sub End If End Sub

في الملف المرفق عندنا جدول من A1 الى F8 وعلى المستخدم ان يملؤه بالترتيب (في كل صف) مثلا اذا قمت بالكتابة في الخلية D4 و كان ما قبلها فارغاً (C4) يقوم الدكتور اكسل بمسح ما قمت بكتابته بعد الخروج من الخلية دون انذار و اذا حذفت اول خلية بالصف يتم حذف كامل الصف الكود Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, Range("A1:F8")) Is Nothing Then If Target.Count = 1 Then del_to_Column (Target.Row) End If End If Application.EnableEvents = True End Sub '================================ Sub del_to_Column(R) Dim My_rg As Range, R_Empty As Range Dim Col% Set My_rg = Cells(R, 1).Resize(, 6) Col = My_rg.Columns.Count Set R_Empty = My_rg.Find(vbNullString, After:=Cells(R, 6)) If Not R_Empty Is Nothing Then R_Empty.Resize(, Col - R_Empty.Column + 1) = vbNullString End If End Sub الملف مرفق write_by_order.xlsm

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

على اعتبار ان حقل المجموع اسمه = txtQuantity ضع هذا الكود على زر الامر جديد Select Case Nz(txtQuantity, "") Case "" MsgBox "Quantity is empty, include the Quantity please" Case Is <= 0 MsgBox "Quantity is zero or less, include the Quantity please" Case Is > 0 DoCmd.GoToRecord , , acNewRec End Select

في مربع نص الكمية وفي حدث عند الخروج ضع هذا الكود ... مع تعديل ما يلزم If IsNull(Me.Namex) Then ' Namex هو اسم مربع نص الكمية MsgBox "ادخل بيانات", vbCritical, "dATA" DoCmd.CancelEvent End If

السلام عليكم هذا البرنامج محمي - يجب الرجوع لمالكه - والا كان هذا تعدي علي حقوق الغير, وهذا لن تجد من يساعدك عليه هنا!!! اذا كنت متأكد أن صانع هذا البرنامج من أحد الأعضاء بالمنتدي يمكنك مخاطبته مباشرة وطلب المساعدة أو يمكنك طرح فكرتك التي تريد أن تقوم بها وستجد ايادي العون البيضاء من اخوتك بالمنتدي قد امتدت اليك من كل جهة ان شاء الله

وعليكم السلام Total.xlsm

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

وذلك بهذا الكود Sub InsertPageBreaksByKeyphrase() Dim rangeSelection As Range Dim cellCurrent As Range Set rangeSelection = Application.Selection ActiveSheet.ResetAllPageBreaks For Each cellCurrent In rangeSelection If cellCurrent.Value = "رقم البطاقة التموينية" Then ActiveSheet.Rows(cellCurrent.Row + 1).PageBreak = _ xlPageBreakManual End If Next cellCurrent End Sub

وعليكم السلام-وذلك كما بالصورة

وعليكم السلام-جرب هذا 1.xlsm

تفضل جرب هذا الفيديو https://www.youtube.com/watch?v=0NBrHj5Ca4E

تفضل لك ما طلبت Date1.xlsx

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

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

جرب هذا الماكرو بالنسبة للملفات HR_test Option Explicit Sub copy_data() Dim S As Worksheet: Set S = Sheets("Shift Schedule") Dim O As Worksheet: Set O = Sheets("Overtime") Dim A As Worksheet: Set A = Sheets("Attendance") Dim Final_S: Final_S = S.Cells(Rows.Count, 1).End(3).Row Dim Final_O: Final_O = O.Cells(Rows.Count, 1).End(3).Row Dim Final_A: Final_A = A.Cells(Rows.Count, 1).End(3).Row Dim Rs As Range: Set Rs = S.Range("A8:AG" & Final_S) Dim RO As Range: Set RO = O.Range("A8:AG" & Final_O) Dim RA As Range: Set RA = A.Range("A8:AG" & Final_A) Dim i%, xO%, XA%, xx% xO = RO.Rows.Count: XA = RA.Rows.Count Rs.ClearContents i = 1: xx = 8 Do Until i > xO S.Cells(xx, 1) = RO.Cells(i, 1) S.Cells(xx, 3).Resize(, RO.Columns.Count - 2).Value = _ RO.Cells(i, 3).Resize(, RO.Columns.Count - 2).Value i = i + 1: xx = xx + 2 Loop i = 1: xx = 9 Do Until i > XA S.Cells(xx, 1) = RA.Cells(i, 1) S.Cells(xx, 3).Resize(, RA.Columns.Count - 2).Value = _ RA.Cells(i, 3).Resize(, RA.Columns.Count - 2).Value i = i + 1: xx = xx + 2 Loop End Sub الملف مرفق Salim_TEST3.xlsm

تفضل هذا الاقتراح الضريبة.accdb

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

اخي الكريم لنفترض انه لديك جدول للمستخدمين (UserId , UserName , Password , UserTayb, Additions (Yeas / No), Deletions (Yeas / No), Edits (Yeas / No)) ففي شاشة الدخول LOGIN نحتاج لتعريف متغيرات عامة من نوع Global حسب جدول المستخدمين ففي حال تطابق اسم المستخدم مع كلمة المرور يتم جلب بيانات المستخدم و تخزينها في المتغييرات اذا فالفكرة العامة بأن نقوم بجلب صلاحيات المستخدم و تطبيقها على جميع النماذج من خلال الاتصال بالموديل Call ففي جميع الأحوال يتم التطبيق حسب حاجة التصميم لديك

تفضل التعديل اخي الكريم ==>> بالماكرو Database2.accdb

اذا تفضل هذا التعديل Database2.accdb

تحياتي الخالصة تفضل المطلوب في الملف المرفق... بن علية حاجي تقرير (1).xlsx

هو لا يريد منع الحذف .. يريد منع الحذف من لوحة المفاتيح والسماح بالحذف من النموذج

تفضل اخي الكريم هذا الكود لانشاء نسخة احتياطية مماثلة في ازرار النسخة الاحتياطية ضع في حدث عند الضغط الكود التالي كما انصحك بأن تضع هذا كود ضمن امر الحفظ Dim MyFile, DstFile As String Dim Syso As Object On Error GoTo ErrH MyFile = CurrentProject.FullName DstFile = CurrentProject.Path & "\Backup-" & Format(Date, "dd-mm-yyyy") & ".accdb" DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing Name DstFile As DstFile & ".ptc" DBEngine.CompactDatabase DstFile & ".ptc", DstFile Kill DstFile & ".ptc" MsgBox "تم انشاء قاعدة البيانات بنجاح" & vbNewLine & "Database successfully created" & vbNewLine & vbNewLine & "" & "اسم قاعدة البيانات" & vbNewLine & "The name of the database" & vbNewLine & "" & vbNewLine & "Backup-" & Format(Date, "dd-mm-yyyy") & vbNewLine & vbNewLine & "" & "مسار القاعدة الجديدة" & vbNewLine & "Path of the new rule" & vbNewLine & "" & vbNewLine & DstFile, vbMsgBoxRight + vbOKOnly, "emphasis" & "/" & "تاكيد" Exit Sub ErrH: Select Case Err.Number End Select

اخي الكريم ضع في حدث عند الفتح الكود التالي لمنع الحذف Me.AllowDeletions = False =================================== خيارات اخرى يمكن وضعها مع صلاحيات المستخدمين لمنع التعديل Me.AllowEdits = False لمنع الاضافة Me.AllowAdditions = False

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 46 Then KeyCode = 0 MsgBox "يمكنك الحذف من النموذج فقط" End If End Sub

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

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

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

السلام عليكم و رحمة الله و بركاته الملف المرفق عبارة عن حماية من التلاعب بتاريخ البرنامج و ذلك عن طريق مراقبة التاريخ و الوقت الموجود في الحاسوب .. دمتم بخير تحياتي لكم منع التلاعب في التاريخ.mdb

هل جربت فيه ملفك و نجح حسب المطلوب؟ اذا جواب نعم ممكن رفع مثال توضيحي او صورة عنه؟

اليوزر والباسورد 1 1 2 2 هذا المثال يا استاذ @محمد صلاح1 فى ابسط حالاته بعد التعديل البسيط حسب طلبك الكود الذى يتم وضعه على النماذج للتاكد من الصلاحيات المعطاه FrmAbilities (Me.Name) If ContinueCode = False Then Exit Sub والتقرير ReportAbilities (Me.Name) If ContinueCode = False Then Exit Sub مثال صلاحيات.mdb

مسابقات دينية سؤال وجواب الصور مسابقات دينية سؤال وجواب.rar

اقصد 10 الاولى في الصورة

لو مظبطش معاك ابعت لي الملف على الايميل وانا ان شاء الله اعمل اللازم alaaaboulela@gmail.com

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

السلام عليكم-تم التوفيق لإضافة رفع ملفات الإكسيل ذات الإمتداد Xlsb بدون ضغط وذلك لتسهيل رفع الملفات الضخمة المعقدة ذات المعادلات الكثيرة بارك الله فيك استاذ محمد طاهر والى الأمام والتفوق دائما

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

وعليكم السلام تفضل اخي ان شاء الله تجد ضالتك هون البركه في استاذنا محمد صالح الله يعطيه العافيه صاحب البرنامج لعلك تستفيد منه لجميع مفاتيح الكيبورد open form by keys.accdb

تفضل هذا المثال اخي الكريم طريقة بالاستعلام و طريقة بالكود حساب التقاعد.accdb

وعليكم السلام جرب هذه المعادلة =distVincenty(SignIt(A3), SignIt(B3), SignIt(C3), SignIt(D3))

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

أهلا بك اخ كريم فى المنتدى تفضل لك ما طلبت sum k9 numbers.xls

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

وعليكم السلام استاذ هشام-اهلا بك اخ كريم فى المنتدى تفضل هذ الكود به طلبك -يعمل على حماية الخلايا بعد الحفظ Public Sub Ziad_Prodc() Dim Sh As Worksheet Dim Rng As Range Ch_P On Error Resume Next With Application .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False For Each Sh In ThisWorkbook.Worksheets If Sh.ProtectContents = True Then Sh.Unprotect Password:="123": Sh.Cells.Locked = False If Not Sh.Cells.HasFormula Then Sh.Cells.Locked = False Else Sh.Cells.FormulaHidden = True With Sh.Cells .SpecialCells(2).Locked = True .SpecialCells(-4123).Locked = True End With If Sh.Cells(1, "IV") = "True" Then Sh.Protect Password:="123" Next .EnableEvents = True .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub Private Sub Ch_P() Dim Sn As Worksheet For Each Sn In ThisWorkbook.Worksheets If Sn.ProtectContents = True Then Sn.Unprotect Password:="123": Sn.Cells(1, "IV") = "True": Sn.Protect Password:="123" Next End Sub

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

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

من فضلك قم برفع الملف نفسه وليس صورة منه وان شاء الله ستلقى الحل والمساعدة بارك الله فيك

بعد اذن استاذنا الكبير بن علية حاجى جرب هذا تقريب الرقم العشري.xls

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