ياسر خليل أبو البراء

بارك الله فيك أخي الكريم سامح طاهر وجزيت خيراً على مرورك العطر بالموضوع تقبل تحياتي

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

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

أخي الكريم ناصر سعيد .. ------------------------------ للعلم أنه ليس كود يتم تنفيذه إنما دالة معرفة تؤدي غرض معين .. الدالة المعرفة يتم استخدامها في الإكسيل كالدوال العادية التي تستخدمها Function DisplayFormula(cel As Range) Dim str As String str = Replace(cel.Formula, """", """""") DisplayFormula = "[" & cel.Address(0, 0) & "].Formula=" & """" & str & """" End Function هذه هي شكل الدالة المعرفة وتوضع في موديول عادي مثلها مثل الأكواد العادية .. ويمكن استخدامها في ورقة العمل بشكل مباشر بعد ذلك مثال : ضع القيمة 10 في الخلية A1 وضع القيمة 15 في الخلية A2 واكتب المعادلة التالية في الخلية A3 لجمع الخليتين =SUM(A1:A2) الآن في أي خلية وليكن الخلية E10 ضع المعادلة التالية التي سنستخدم فيها الدالة المعرفة =DisplayFormula(A3) ناتج المعادلة الخاصة بالدالة المعرفة سيكون كالتالي [A3].Formula="=SUM(A1:A2)" وهذا هو مربط الفرس أنه بهذا السطر أصبحت قادراً على أن تأخذ المعادلة بهذا الشكل وتنفذها من خلال محرر الأكواد في كود آخر .. أي أن الدالة المعرفة DisplayFormula تقوم بإظهار شكل السطر المطلوب لتنفيذ المعادلة في الأكواد .. يمكنك نسخ هذا السطر على سبيل المثال في كود آخر بهذا الشكل (قم بنسخ الكود التالي) Sub TestRun() [A3].Formula = "=SUM(A1:A2)" End Sub الآن قم بمسح محتويات الخلية A3 التي تحتوي على معادلة بالفعل وقم بتنفيذ الإجراء الفرعي الذي قمت بوضعه في محرر الأكواد والمسمى TestRun ..(اضغط Alt + F8) من لوحة المفاتيح وأنت في ورقة العمل لتظهر لك الأكواد .. اختر الكود المسمى TestRun ولاحظ الخلية A3 ... ستجد أن الكود يقوم بوضع المعادلة في الخلية A3 بهذا السطر .. أرجو أن أكون وفقت في توصيل المعلومة (يا ريت بقا تغير اسم الظهور للغة العربية وإلا هعتبر دا خصاااااااام ومش هرد عليك تاني ) تقبل تحياتي

أخي الكريم ماجد ماجد أهلاً بك في المنتدى ونورت بين إخوانك يرجى تغيير اسم الظهور للغة العربية ، كما يرجى الإطلاع على موضوع التوجيهات في الموضوعات المثبتة في المنتدى لمعرفة كيفية التعامل مع المنتدى بشكل أفضل لا داعي للعناوين البراقة (التحدي وخلافه) ، فكلنا هنا نسعى للتعلم بجد وليس من باب التحدي .. وإذا كان الباب هو التحدي فمن الأجدر أن يكون لديك حل للمسألة .. كأن تكتب في العنوان لغز أو خلافه ، أما التحدي في موضوع تطلب فيه مسألة معينة فغير مقبول (على الأقل بالنسبة لي) عموماً حتى لا ندخل في نقاشات لا جدوى منها .. إليك الجزء الأول من طلبك ضع الكود التالي في حدث المصنف ThisWorkbook Private Sub Workbook_Open() Recalc End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) EndTime End Sub وضع الكود التالي في موديول جديد Dim SchedRecalc As Date Sub Recalc() Range("A1").Value = Format(Time, "hh:mm:ss AM/PM") Call StartTime End Sub Sub StartTime() SchedRecalc = Now + TimeValue("00:00:01") Application.OnTime SchedRecalc, "Recalc" End Sub Sub EndTime() On Error Resume Next Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Recalc", Schedule:=False End Sub إليك الملف المرفق فيه تطبيق الكود ** ملحوظة هامة : قمت بتنفيذ الجزء الأول مع عدم اقتناعي بفكر تحديث الوقت كل ثانية لأن ذلك سيكون إرهاق على الملف نظراً لأن التحديث سيكون كل ثانية .. أعتقد يمكن تنفيذ الجزء الثاني بدون تحديث الوقت في الخلية A1 ... ولكن تم تنفيذ الجزء الأول من باب التحدي تقبل تحياتي Update Timer Every Second In Cell YasserKhalil.rar *********************************** بعدما اطلعت على الجزء الثاني من طلبك فقد اتضح لي أنه يمكن التعديل على الكود السابق بسهولة ليؤدي الغرض ويقوم بعملية الترحيل كل ثانية كما طلبت قم بتعديل الكود Sub Recalc() Range("A2").Value = Format(Time, "hh:mm:ss AM/PM") Range("C" & Cells(Rows.Count, "C").End(xlUp).Row + 1).Value = Range("B2").Value Call StartTime End Sub وإليك الملف المرفق الثاني بعد التعديل تقبل تحياتي Update Timer Every Second In Cell YasserKhalil V2.rar

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

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

أخي الكريم الدالة المعرفة تقوم بتجهيز المعادلة أياً كان مكانها في أي خلية .. بحيث يمكنك استخدام المعادلة في محرر الاكواد .. هذه هي الفائدة من الموضوع .. هو أن الدالة ستمكنك من تحويل المعادلة إلى الشكل الذي يمكنك من خلاله استخدامه في محرر الأكواد * يرجى عدم استخدام الاقتباسات إلا للضرورة تقبل تحياتي

أخي الحبيب أحمدأنا بس بحب أناغشك وأهزر معاك .. ولد من دمياط بيقول أبوه عايز جنيه .. رد ابوه وقاله : عاااااااااااااايز نص جنيه ، هتعمل ايه بالربع جنيه ، معايا بريزه تاخد شلن وتسيب شلن!! تقبل تحياتي

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

بارك الله فيك أخي الحبيب الزباري وجزيت خيراً على الموضوع الرائع والممتع الفكرة جميلة ولكنها تحتاج لتطوير بالفعل .. حيث أنه إذا قمت بتحربة الدالة المعرفة وقمت بنسخ الناتج لمحرر الأكواد .. بهذا الشكل Sub TestRun() [c1].Formula = "=IFERROR(VLOOKUP(M2,$M$2:$N$7,2,0),"")" End Sub ستظهر رسالة خطأ بهذا الشكل وسبب الخطأ هو أن علامات التنصيص يجب أن توضع بين علامتي تنصيص أخرى يجب أن تكون هكذا Sub TestRun() [c1].Formula = "=IFERROR(VLOOKUP(M2,$M$2:$N$7,2,0),"""")" End Sub ************* خطرت لي فكرة وهي استبدال التصيص بعلامتي تنصيص في المعادلة لكي تعمل بشكل جيد الدالة المعرفة والاعتماد على أن تكون الدالة مطاطية بحيث تقدر تنسخ أي معادلة من أي خلية بالاعتماد على عنوان الخلية الهدف الدالة بعد التعديل كالتالي Function DisplayFormula(cel As Range) Dim str As String str = Replace(cel.Formula, """", """""") DisplayFormula = "[" & cel.Address(0, 0) & "].Formula=" & """" & str & """" End Function الآن سيظهر السطر الخاص بالمعادلة جاهز للعمل ويمكنك نسخه لمحرر الأكواد واستخدامه بكل سهولة تقبل تحياتي

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

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

تتعشى ولا تنام خفيف ..تشرب شاي ولا إنت مش كييف .. تنام هنا ولا تحب نوم الرصيف يا حاج أنا أحب أنام خفيف ومش بشرب الشاي عشان بيجيب أنيميا وبحب أنام في الهوا لأن خلاص الصيف بدأ يطل علينا تقبل تحياتي

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

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

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

بارك الله فيك وجزاك الله خيراً أخي الحبيب أبو عيد متميز كالعادة .. أنت متمكن في الحلقات التكرارية بشكل كبير جداً .. تتبعت كود ووجدته رائع وجميل ولكنه بطيء قليلاً بسبب الحلقات التكرارية LOOPS تقبل وافر تقديري واحترامي

أخي الحبيب رجب جاويش أجزت فأوجزت فأنجزت .. بارك الله لنا فيك .. وننتظر مشاركاتك في الموضوع الأسبوعي لإثراء الموضوع ، فأنت من أعلام المنتدى لا حرمنا الله منك أبد الدهر تقبل تحياتي

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

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

لقد ارهقتني أخي الحبيب عبد العزيز ..لأنني بصراحة في قمة التعب ..كان ممكن تأجلها لبكرة ، لكن مقدرش أقولك لا أو أرفض لك طلب أبدا أبدا لأنك حبيبي في الله ، ويعلم الله مقدار معزتك في قلبي إليك التعديل في أسطر الإعلان #If VBA7 Then Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long #Else Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long #End If والسلام عليكم ورحمة الله وبركاته

أخي الحبيب عبد العزيز هلا جعلت الملف يعمل على الـ 64 بت ؟ حاول تعدل في أسطر الإعلان API لتتناسب مع الـ 32 بت و الـ 64 بت ..حتى أتمكن من تجربة الملف وموافاتك بالنتيجة أعتذر عن القيام بالتعديل لقلة الوقت .. فقد أوشك وقتي على الانقضاء وحان موعد النوم بعد قليل تقبل تحياتي

بالنسبة للمعادلة تتعطل عن العمل بعد التعديل لأنها معادلة صفيف أي يجب أخي الكريم أبو ذكري أن تقوم بالضغط على Ctrl + Shift + Enter بعد التعديل .. ستلاحظ بعدها ظهور أقواس في بداية المعادلة ونهايتها .. جرب مرة أخرى لأن المعادلة تعمل بشكل جيد تقبل تحياتي

مشكور على مرورك الطيب والعطر أخي الطيب محمد علي الطيب