عبدالله بشير عبدالله

وعليكم السلام ورحمة الله وبركاته Private Sub Worksheet_Change(ByVal Target As Range) Dim rg As Range, cell As Range Set rg = Intersect(Target, Columns("A")) If rg Is Nothing Then Exit Sub Application.EnableEvents = False On Error GoTo CleanUp For Each cell In rg If Not IsEmpty(cell.Value) Then If Not cell.Value Like "???-###-####" Or _ IsNumeric(Left(cell.Value, 3)) Or _ Not IsNumeric(Mid(cell.Value, 5, 3)) Or _ Not IsNumeric(Mid(cell.Value, 9, 4)) Then MsgBox "الرجاء إدخال القيمة بالتنسيق الصحيح: 3 حروف-3 ارقام-4 ارقام", vbExclamation cell.ClearContents End If End If Next cell CleanUp: Application.EnableEvents = True End Sub aaa-123-4345.xlsb

وعليكم السلام ورحمة الله تعالى وبركاته جرب الملف يتم الحدف عند الادخال او عند اللصق Private Sub Worksheet_Change(ByVal Target As Range) Dim rngChanged As Range Dim cell As Range Dim dict As Object Dim lastRow As Long Dim ws As Worksheet Set ws = Me lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row Set rngChanged = Intersect(Target, ws.Range("A1:A" & lastRow)) If rngChanged Is Nothing Then Exit Sub Application.EnableEvents = False Application.ScreenUpdating = False Set dict = CreateObject("Scripting.Dictionary") For Each cell In ws.Range("A1:A" & lastRow) If Not Intersect(cell, rngChanged) Is Nothing Then GoTo NextCell If Not IsEmpty(cell.Value) Then dict.Add CStr(cell.Value), 1 End If NextCell: Next cell For Each cell In rngChanged If Not IsEmpty(cell.Value) Then If dict.exists(CStr(cell.Value)) Then Application.Undo ' MsgBox "القيمة '" & cell.Value & "' موجودة مسبقاً!", vbExclamation, "تنبيه" Exit For Else dict.Add CStr(cell.Value), 1 End If End If Next cell Application.EnableEvents = True Application.ScreenUpdating = True End Sub no duplicate.xlsb

السلام عليكم ورحمة الله وبركاته جرب التعديل التالي جدول التفريغ V2 (1).xlsm

احسنت استاذ hegazee الفكرة بسيطة وعملية تبقى مشكلة لو وجدت اكثر من مادة مباعة لها تفس القيمة تحياتي

وعليكم السلام ورحمة الله وبركاته حسب قهمي لطلبك اليك الملف في حالة تساوي القيم الاعلى يتم دكرها مع تظليل الصف Book4.xlsb

السلام عليكم ورحمة الله وبركاته لا اعتقد ان طلبك يمكن عمله بالمعادلات ولكن يمكن بالكود اكتب اسم المستخدم وكلمة السر للمدرسة وسيتم اخفاء كل الصفحات ما عدا صفحة المدرسة وصفحة main الزر الاخر لاظهار كل الصفحات فربما تحتاجه اثناء تجهيز ملفك ويمكنك حذفه لاحقا جرب الملف وات كان هناك ملاحظات اذكرها DATA.xlsb

السلام عليكم ورحمة الله وبركاته بعد اذن معلمنا واستاذنا محمد هشام جدول2.xlsm

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

ما شاء الله هديه مقبولة جزاك الله كل خير

السلام عليكم انتبه الى الملاحظة التي كتبها معلمنا الاستاذ محمد صالح مجلد C:\Windows هو مجلد نظام، ولا يُسمح للبرامج العادية (بدون صلاحيات مسؤول) بإنشاء أو تعديل ملفات بداخله وهذا هو سبب ظهور الخطأ بالماوس الايمن على تطبيق اكسل وليس ملف الاكسل قم باختيار تشغيل كمسؤول وسيعمل الكود وينشئ الملف وقد فمت بالتجرية وكانت تاجحة بالتمام والكمال نحياني

وعليكم السلام ورحمة الله وبركاته جرب التعديل التالي حسب ملفك المرفق اعداد الحجم الملائمة الى 1 عرضا - 1 طولا قم بالتاشير على الخيار الاول الضبط الى

السلام عليكم ورحمة الله وبركاته حسب فهمي لمشكلة عدم الحفظ السبب ان امنداد ملفك xlsx (المقصود بالامتداد يكون بعد اسم الملف) هذا النوع من الامتداد لا تحتفظ بالأكواد (مثل أكواد VBA) لأنها مصممة فقط لتخزين البيانات والصيغ والرسومات — ولكن دون دعم للماكرو أو الأكواد البرمجية. انواع الامتداد التي تحتفظ بالاكواد xlsm - xlsb او xls لاصدار 2003 او اقل قم بوضع الكود في ملقك ثم اختر ملف ثم حفظ باسم واختار اما xlsm او xlsb ثم احفظ الملف على سطح المكتب مثلا قم بفتح الملف الجديد الذي قمت بحفظه وليس الاول ستجد الكود بداخله اليك مثال لاحظ الامتداد New Microsoft Excel Worksheet.xlsb هذا حسب فهمي لطلبك وان كان ما دكرته ليس المطلوب فاوضح اكثر

اخونا الفاضل لا يمكن حل المشكلة من خلال صورة بدون ملف مرفق يبقى مخاولات تخطى وتصيب بالنسبة لهذه الصورة قم بالدخول الى محرر الاكواد وطبق خسب الصور قم بالغاء التاشير على اي شئ بدايته missing اذا لم يتجح الامر قم برقع ملفك لمعرفة المشكلة اما الصورة الاخرى هذا الخطأ يظهر في Excel VBA عندما تحاول استخدام كائن (مثل ورقة عمل أو عنصر تحكم أو كائن Word) دون أن تكون قد قمت بتعيينه أو تعريفه بشكل صحيح وهذا يحتاج الى ارفاق الملف او الكود لمعرفة الخطا والله اعلم

السلام عليكم حسب فهمى لطلبك وبدون ارفاق ملف منكم اليك الكود Sub RunMacroWithPassword() Dim password As String Dim userInput As String password = "1234" userInput = InputBox("من فضلك أدخل كلمة السر لتشغيل الماكرو:", "كلمة السر") If userInput = password Then MsgBox "كلمة السر صحيحة، سيتم الآن تشغيل الماكرو.", vbInformation Call MyProtectedMacro Else MsgBox "كلمة السر غير صحيحة. لن يتم تشغيل الماكرو.", vbCritical End If End Sub Sub MyProtectedMacro() MsgBox "تم تشغيل الماكرو بنجاح!", vbInformation ' أضف الكود الحقيقي هنا... End Sub الكود الاول Sub RunMacroWithPassword() وفيه المطالبة بكلمة السر وهي 1234 والكود الثاني Sub MyProtectedMacro() وهو الذي سيتم تنفيذه بعد وضع كلمة السر مثال تنفيذ ماكرو مع ادخال كلمة سر.xlsb

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

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

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

وعليكم السلام ورحمة الله وبركاته يبدو اثناء تجهيز الملف تغير الطلب تم التعديل حسب الطلب الجديد حسب فهمى ات H2 موعد السداد تاريخ الأستحقاق.xlsb

وعليكم السلام ورحمة الله وبركانه اليك الملف وبه التعديل ترحيل بيانات الموظف المحال للمعاش إلى شيت آخر وحذفه من قاعدة البيانات 5.xlsb وان اردت اي تعديل في الملف فايشر لك كل الود والاحترام

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

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

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

وعليكم السلام ورحمة الله وبركانه الكود يقوم بفرز الاسماء المكررة ويضعها في العمود C Sub تجميع() Dim ws As Worksheet Dim lastRow As Long, i As Long, j As Long Dim dict As Object Dim name As Variant, location As String Dim outputRow As Long Set ws = ActiveSheet Set dict = CreateObject("Scripting.Dictionary") lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row For i = 1 To lastRow name = ws.Cells(i, 1).Value location = ws.Cells(i, 2).Value If name <> "" Then If dict.Exists(name) Then dict(name) = dict(name) & " / " & location Else dict(name) = location End If End If Next i ws.Range("C1:D" & ws.Rows.Count).ClearContents outputRow = 1 For Each name In dict.Keys ws.Cells(outputRow, 3).Value = name ws.Cells(outputRow, 4).Value = dict(name) outputRow = outputRow + 1 Next name End Sub Book2.xlsb

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

تم التعديل استمارة الكترونية1.xlsm