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

وعليكم السلام ورحمة الله وبركاته 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

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