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

السلام عليكم 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- تحديث النسخة السابقة انتظر ردك وتعليقك

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

السلام عليكم إخواني/أخواتي البرنامج الاصل هنا: http://www.officena.net/ib/index.php?showtopic=60235&p=386739 ولكن الظاهر ان بعض الشباب رأى بأن البرنامج اصبح معقد ، لذلك ، الغيت جميع النماذج والجداول التي لا علاقة لها بالماسح الضوئي scanner ولشرح اضافي لعمل البرنامج: الهدف من البرنامج هو سرعة العمل ، بحيث انك تضبط الاعدادات مرة واحدة ، وتحفظ كل اعداد بإسم Profile مختلف ، وفي عملية المسح ، كل ما عليك عمله هو اختيار Profile من القائمة المنسدلة ، وتضغط على الزر Scan 1. تستطيع ان تستعمل اكثر من ماسح ضوئي ، 2. لكل ماسح تستطيع ان تعمل اكثر من Profile واحد ، وكما تلاحظ في الصورة المرفقة ، فقد عملت 4 Profiles للماسح HP Officejet Pro 8500: أ- للمسح من زجاج Glass الماسح (لمسح ورقة واحدة) ، ب- للمسح من الملقم Feeder (لمسح اكثر من ورقة واحدة) ، (هناك بعض البرامج تسألك مسبقاُ عن عدد الاوراق التي تريد سحبها ، ولكن برنامجي لا يسأل ) ، ج- للمسح من الملقم Feeder ، Duplex (لمسح اكثر من ورقة واحدة ، من جانبي الورقة ، طبعا اذا كان الماسح يحمل هذه الميزة) ، . 3. لكل Profile ، تستطيع ان تضبط مجموعة اعدادات ، ومنها صيغة حفظ الصورة كـ pdf او jpg او png او tif ، والسبب ان عندي عدد 2 Profile للملقم Feeder ، هو ان احدها يمسح الاوراق ويحفظها جميعا في ملف بصيغة pdf ، بينما الـ Profile الاخر يحفظ كل ورقة بصيغة jpg متسلسلة ، (هناك بعض البرامج التي تقول بأنها تحفظ الصورة بصيغة jpg ، ولكن الصورة في الواقع بصيغة Bmp ، فمجرد تغيير اسم صيغة الملف لا يغير صيغة الملف نفسه) ، ملاحظة هامة: البرنامج لا يتأكد من وجود صور سابقة في مجلد الحفظ ، فإنه يحذف الصور السابقة ويستبدلها بصور جديدة. 4. الميزة في عمل اكثر من Profile لكل ماسح ، هو انه ، عند المسح ، فانك لا ترجع وتختار الاعدادات في كل مرة تريد المسح ، وانما تختار اسم Profile ، وتضغط على زر المسح (البرامج الاخرى ، إما انها لا تعطيك خيارات تضبيط الاعدادات ، او انك تضطر الى تضبيط الاعدادات في كل مرة تريد المسح) ، لاحظ في الصورة التالية ، الاعدادات التي تم حفظها مسبقا للـ Profile HP8500_Duplex ، فكل الذي تعمله هنا هو اختيار Profile من الرقم 1 ، ثم تضغط على الرقم 9 للمسح : . 5. العيب الذي يُوجه الى البرنامج ، انه يستخدم وسيط خارجي وهو NAPS2 ، بينما جميع البرامج الاخرى تستخدم وسيط خارجي ايضا مثل مكتبة wia جعفر Scan_Link_Images_pdf_Files2.zip

هذا على حسب عدد اعمدة كومبوبوكس مثلاً عمود 1 و مصدره نفس حقل في جدول ، كما هو اما اذا عدد أعمدة أكثر من 1 هنا يكن اول عمود رقمي و هذا يعتبر قيمة كومبو بوكس وفي جدول يكن حقل رقمي مصدره ايضا رغم عرض قيمة نصية في كومبو بوكس وفي الحالة يتطلب تغير في الكود. باختصار انشيء مربع نص في نموذج ثم اكتب بداخلها =[ComboboxName] كمصدر تلك المربع اذا عرض نفس نص كما هو في كومبوبوكس ، عادي لا فرق بين كومبوبوكس او غير كومبوبوكس اما اذا عرض رقم، يجب تعديل الكود كي يتعامل مع كومبوبو كحقل رقمي.

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

آمين آمين وياك

تفضل أخي التعديل على حسب القسم و درجة test 2.accdb

السلام عليكم جرب المرفق لعل فيه ما تريد.... سند.xlsx

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

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

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

جرب شغلbenyasien كمسئول benyasien.rar

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

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

لو كانت الخدمة اقل من 20 سنة هل يستحق راتب تقاعدي ولو كانت 40 سنة يستحق حسب وصفك 100% من الراتب ولو خدم اكثر من 40 سنة هل يبقي عند حد 100% من الراتب استفسارات كثير ولكن مهمه لعمل صحيح

هذا كود جلب الوقت من الانترنت " توقيت جرينتش " Dim UTCDateTime As String Dim arrDT() As String Dim http As Object Dim UTCDate As String Dim UTCTime As String Const NetTime As String = "https://www.time.gov/" On Error Resume Next Set http = CreateObject("Microsoft.XMLHTTP") On Error GoTo 0 http.Open "sa", NetTime & Now(), False, "", "" http.Send UTCDateTime = http.getResponseHeader("date") [Text1] = UTCDateTime

جرب هذا الكود ... DoCmd.RunCommand acCmdSelectRecord لتحديد السجل

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

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

وعليكم السلام استاذ هشام-اهلا بك اخ كريم فى المنتدى تفضل هذ الكود به طلبك -يعمل على حماية الخلايا بعد الحفظ 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

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

تفضل لك ما طلبت -1التقرير.xlsm

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

هذا ما كنت اعرفه ، فجزاك الله خيرا على هذه المعلومة ولكن نرجع لأصل الموضوع اللي بسببه انا وضعت الكود ، فنرى مدى ما يمكن ان يصل اليه التعقيد عن طريق الداله Format ، وانا على يقين بأنك لم تصل للطريقة الصحيحة للكود من اول مرة او مرتين لهذا السبب ، اعتقد بأن الدالة DateFormat تسهل الكود كثيرا جعفر