مختار حسين محمود

أشكرك على ثناءك على الكود ودعاءك لى الحمد لله الذى وفقنى الى ما تريد تحياتى

السلام عليكم و رحمة الله وبركاته اليك الملف التالى عله يفى بالغرض الكود ينجم عنه ملف باسم (Debits ) يعنى الديون أو الأقساط المستحقة + تاريخ اليوم والساعة والثانية التى تم فيها انشاء الملف الكود طويل نوعا ما لكنه سريع و يحقق ما تصبو اليه واذا توصلت الى كودا أسرع وأبسط سأرفعه لك ملحوظه مهمة : فى الكود يتم انشاء شيت جديد باسم الديون بنجمع فيه الديون هذا الشيت يتم نسخه الى الملف الجديد ثم يحذف يمكنك الابقاء على هذا الشيت فى الملف الأصلى للاطلاع على الديون بالغاء السطر الخاص بحذف الشيت . مع خالص تحياتى نمودج من اصناف Molhtar 1.rar

السلام عليكم ورحمة الله وبركاته الى كل كل الأخوة الكرام فى المنتدى كل عام وأنتم بخير أخى الكريم النطاق يتحرك الى أعلى بسبب حذف صف لكى يبقى النطاق ثابتا نزود صف بدلا من المحذوف فوق النطاق مباشرة ( تم تعديل الكود ) 3حذف و لصق.rar

أشكرك اعذرنى على عدم استيعاب طلب الاخير الحمد لله أنك توصلت الى مبتغاك تحياتى

جرب دوائر مختار 2.rar

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

ما هو التعديل المطلوب ؟

السلام عليكم بدون تنسيق شرطى و بدون الكود فى الملف الاصلى تفضل الملف بكود جديد وأسهل من الاصلى عسى أن يكون المطلوب دوائر مختار.rar

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

أستاذ جمال اسم الشيت فى ملفك به مسافة فارغة لم تدرج فى الكود قد يكون هذا هو السبب المرفق التالى يحفظ نسخة من الشيت اذا كان الوقت يساوى أو أكبر من الساعة 7 مساء يمكنك التعديل بيان وقتى 3.xls

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

وأنت فاتح ملف الاكسل اضغط المفتاحين Alt + F11 معا هتلاقى نافذة محرر الاكواد من فوق هتلاقى قوائم من ضمنها قائمة insert اختر مديول هتفتح معاك صفحة بيضاء هذه الصفحة هى نافذة محرر الاكواد بنكتب و نلصق فيها الاكواد جرب الملف ده هتلاقى جواه كود حفظ الشيت كملف جديد بيان وقتى 2.rar

طبقا لما طلبته تفضل ضع هذا الكود فى مديول عادى الكود يعمل يوميا و بشكل تلقائى الساعة 10 صباحا بالثانية يعنى حضرتك لازم تكون فاتح اكسل قبلها الكود سوف يحفظ الشيت رقم 2 كملف جديد كما طلبت فى المرفق فى البارتش D وأضفت لك الوقت ( تاريخ اليوم والساعة والثانية ) لاسم الملف عشان تفرق بين الملفات الناتجة بالتاريخ Option Explicit Sub Auto_Open() Dim MyTime As Date MyTime = TimeSerial(10, 0, 0) ' بداية عمل الكود بعد فتح الملف Application.OnTime MyTime, "ExportSpecificSheet" End Sub Sub ExportSpecificSheet() Dim WB As Workbook, WS As Worksheet, fName As String Set WS = ThisWorkbook.Sheets("Sheet2") ' حدد اسم الشيت fName = "D:\" & "نسخة من البيان الوقتى" & "(" & Format(Now, "dd-mm-yyyy hhmmss") & ")" & ".xlsx" ' حدد اسم و مسار وامتداد الملف Application.ScreenUpdating = False Application.DisplayAlerts = False If WB Is Nothing Then WS.Copy WS.UsedRange.Value = WS.UsedRange.Value Set WB = ActiveWorkbook With WB .SaveAs Filename:=fName .Close True End With End If Set WS = Nothing Set WB = Nothing Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "Your's Sheet Exported Now ...", 64 End Sub أخبرنى بالنتيجة تحياتى

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

بعد اذن أستاذى ياسر حسب ما فهمت منك : للمقارنة بين رقمين فى خليتين و ليكن J6 و K6 فى أى خلية ضع المعادلة : ناتج المعادلة الفرق بين الرقمين =IFERROR(ABS( J6-K6 );"") أو المعادله دى لوكنت عايز تم اذا كان الفارق صفر أو ما زال تخت التشغيل اذا كان الفارق لا يساوى صفرا =IFERROR(IF(ABS($J6-$K6 )<>0;"ما زال تحت التشغيل";"تم");"")

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

بارك الله فيك أخى سليم وجزاك خيرا و اثراء للموضوع أخى محمد أضف مجموعة أسماء فى النطاق الذى حددته وجرب الكود التالى : Option Explicit Sub MokhtarRownumber() Dim SNem As String, LR As Long, X As Long SNem = "محمد" With ActiveSheet LR = .Cells(.Rows.Count, "B").End(xlUp).Row For X = 4 To LR If .Cells(X, "B").Value = SNem Then .Cells(X, "C").Value = Split(.Cells(X, "B").Address(1, 0), "$")(1) End If Next X End With End Sub

مشكور أخى ياسر على الموضوع أنا عندى البرنامج ده و بستخدمه على ملفات xls فقط ولم يفلح مع xlsm أو xlsb لم أجرب طريقتك لأنى غير قادر على تحميل الشرح مش عارف ليه يا ريت باختصار طريقتك الخاصة فى صورة نقاط 1 2 3 باخنصار تحياتى أخى عبدالعزيز عذرا الموضوع شدنى ونسانى أسلم عليك لعلك بخير أنت وكل أهل بسكرة تحياتى

مع أنى لا أحبذ تخفيض درجات الأمان الا فى الضرورة الضرورة القصوى جرب الكود التالى يوضع فى حدث الملف Private Sub Workbook_Open() CreateObject("WScript.Shell").Run "%WinDir%\Regedit.exe /s ""ActiveWorkbook.Path & \zaMachineSecurityLevel.reg""" CreateObject("WScript.Shell").Run "%WinDir%\Regedit.exe /s ""ActiveWorkbook.Path & \zaUserSecurityLevel.reg""" End Sub

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

بارك الله فيك أخى ابراهيم حل آخير جربه وهو الغاء ظهور الرسالة أصلا والاكتفاء بازالتها استبدل السطرين دول فى كود الليبل kh_Err: If Err Then MsgBox "Err.Number : " & Err.Number: Err.Clear بالسطرين دول kh_Err: If Err Then Err.Clear مع خالص تقديرى

أخى رجب و حدود الدول أيضا أخى ابراهيم جرب تحط اسم الملف فى متغير dim wb as workbook set wb = activeworkbook وفى نهاية الكود On Error GoTo 1 :1 Application.Goto wb

أخى وأستاذى ياسر يبدو أن النسيان مشى من عند أخى رجب و شرّف عندى و تعمل ايه فى الاستسهال مع تقديرى و شكرى ( ابن عم تحياتى )

بارك الله فيكما أستاذى رجب وأستاذى ياسر و جزاكما خيرا أخى ابراهيم الكود توقف لأنك طبقته على ملف جديد مش الملف 1 المرفق فى مشاركتك الاولى Activate .("اسم الملف") Workbooks لتنشيط الملف و تم اضافة هذا السطر لأن الكود ينشئ ملفا جديدا بأوراق عمل جديدة فصار هذا الملف الجديد هو الملف النشط لذا عند الضغط على زر غلق الفورم x لايدرى اكسل أيهما يغلق ( الفورم أم الملف الجديد النشط ) ولذلك يحدث هذا الخطأ وبناء عليه لجأت الى تنشيط الملف الأصلى مرة أخرى والله أعلى وأعلم

جرب كده Sub CreateSheets_w_name() Dim ws As Worksheet Dim ra As Range Dim name As Range Set ws = Worksheets("اسماء ورقات العمل") With ws Set ra = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row) End With Dim NW As Workbook Set NW = Workbooks.Add On Error Resume Next For Each name In ra If Len(Trim(name.Value)) > 0 Then If Len(Worksheets(name.Value).name) = 0 Then NW.Worksheets.Add(After:=NW.Worksheets(Worksheets.Count)).name = name.Value End If End If Next name On Error GoTo 1 1: Workbooks("1").Activate End Sub