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

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

ضع السطر التالي قبل سطر الخطأ On Error Resume Next

أخي الحبيب أبو تامر كلنا ذو خطأ وجل من لا يسهو .. وتصحيحي ليس بتصحيح على الإطلاق إنما هي محاولة مني لفهم الكود الرائع .. ورجائي عدم الإكثار من الملفات المرفقة قدر الإمكان حيث نريد من الأعضاء أن يقوموا بالتعديل بأنفسهم لكي يتعلموا .. والمرفقات ليست إلا للضرورة وفي أضيق الحدود سؤالي : هل المرفق رقم 7 يختلف كثيراً عن المرفق رقم 6 ؟ أي ما هي الإضافات الأخرى في المرفق سوى الرقم 1 في السطر المشار إليه في مشاركتي السابقة ؟؟ ولي طلب عندك : هل لديك دالة التفقيط الخاصة بالأخ هادي وتكون بآخر تعديلاتها ... أو ضع رابط للموضوع الأصلي الخاص بالدالة؟

وعليكم السلام أخي الكريم محمد جرب الكود التالي في حدث ورقة العمل المسماة "الجدول" كليك يمين على اسم ورقة العمل "الجدول" ثم اختر View Code والصق الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 2 And Target.Column = 3 Then Application.EnableEvents = False Dim iRow iRow = Application.Match(Target.Value, Sheet1.Columns(1), 0) If IsNumeric(iRow) Then Target.Offset(, 1).Value = Sheet1.Cells(iRow, "B").Value End If Application.EnableEvents = True End If End Sub تقبل تحياتي

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

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

أخي الحبيب أبو تامر لقد أتعبتني أكوادك .. محتاجه شهور لدراستها .. عموماً بعد الإطلاع على الكود الرائع والمدهش والمذهل .. وجدت أنه يجب التعديل بإضافة رقم 1 إلى السطر التالي .. Set Rng = Range("G1").Resize(UBound(Arr_Col_7)) وذلك في الإجراء الفرعي المسمي Put_Val في نهاية الكود تقريباً ... السطر بعد التعديل سيكون بهذا الشكل Set Rng = Range("G1").Resize(UBound(Arr_Col_7) + 1) أرجو أن يفي هذا بالغرض إن شاء الله

الحمد لله الذي بنعمته تتم الصالحات هلا أرفقت لنا ملف "محول الدوال السريع" لنستفيد منه أم أنك تريد الاستفادة بدون الإفادة

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

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

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

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

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

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

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

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

بارك الله فيك أخي الكريم يرجى وضع الدالة المعرفة بين أقواس الكود حيث أن الملف الذي قمت بمشاركته لا يحتوي على أية أكواد أو دوال معرفة .. الأخ الكريم الدهشوري .. بالنسبة للمثال المرفق يوجد 45 يوم أليست تمثل شهر و 15 يوم (لما كتبتها 45 يوماً؟!) تقبل تحياتي

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

أخي الكريم وليد صراحة الموضوع مبهم بعض الشيء ولذا لا توجد استجابة جيدة .. حسب فهمي لما هو معروض من معطيات ..أعتقد أنك تريد استيراد بيانات من ملف الورد إلى المصنف الحالي بطريقة معينة ، وهذا صعب بشكل مباشر فخطرت لي فكرة .. وهي كالتالي : أن نقوم بعملية استيراد للبيانات الموجودة في ملف الورد إلى ورقة عمل فارغة وبعدها يمكنك تفصيل المطلوب حتى يمكن للأخوة تقديم المساعدة المطلوبة الخطوة الأولى افتح المستند الموجود لديك (ملف الورد) ثم اضغط Ctrl + A لتحديد كافة البيانات في المستند اذهب للتبويب Insert ثم Table ثم اختر الأمر Convert Text To Table احفظ المستند وأغلق الورد افتح المصنف وأدرج ورقة عمل جديدة .. ادخل لمحرر الأكواد Alt + F11 .. ومن قائمة Insert اختر Module لإدراج موديول جديد ثم قم بلصق الكود التالي Sub Import_Word_Table() Dim wdDoc As Object Dim wdFileName As Variant Dim TableNo As Integer Dim iRow As Long Dim iCol As Integer wdFileName = Application.GetOpenFilename("Word Files (*.docx),*.docx", , "Browse For File Containing Table To Be Imported") If wdFileName = False Then Exit Sub Set wdDoc = GetObject(wdFileName) With wdDoc TableNo = wdDoc.Tables.Count If TableNo = 0 Then MsgBox "This Document Contains No Tables", vbExclamation, "Import Word Table" Exit Sub ElseIf TableNo > 1 Then TableNo = InputBox("This Word Document Contains " & TableNo & " Tables." & vbCrLf & "Enter Table Number Of Table To Import", "Import Word Table", "1") End If With .Tables(TableNo) For iRow = 1 To .Rows.Count For iCol = 1 To .Columns.Count Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) Next iCol Next iRow End With End With Set wdDoc = Nothing End Sub ارجع ورقة العمل ثم اضغط Alt + F8 واختر الإجراء الفرعي Import_Word_Table ثم انقر زر الأمر Run لتنفيذ الكود أرجو أن يكون الحل بداية الطريق لحل المشكلة بالإجمال تقبل تحياتي

ممكن مزيد من التوضيح أخي الكريم سليم ويا ريت لو تضرب مثال لما تقوله حتى تتضح الصورة ..

أخي الكريم زياد .. قمت بشرح الكود بالتفصيل لتتضح لك الصورة بشكل تام وأضفت تعليق يلبي طلبك في حالة أردت أن تقوم بالترقيم في الصف رقم 9 أي الخلية B9 كما أضفت سطر آخر في مكانٍ ما في الكود يوضح لك كيفية التغلب على مشكلة الخلايا الفارغة التي لا ترغب في ترقيمها ، وذلك عن طريق الخروج من الحلقة التكرارية التي تقوم بعملية الترقيم 'تعريف متغير من النوع ورقة عمل Dim ws As Worksheet Private Sub CommandButton1_Click() 'تعريف متغيرات من النوع رقم صحيح طويل يمثلان بداية الصفوف التي سيتم الترقيم من خلالها Dim lLrw1 As Long, lLrw2 As Long 'إذا كان صندوق النص فارغ يتم الخروج من الإجراء الفرعي أي لا يتم تنفيذ بقية السطور التالية If TextBox1 = "" Then Exit Sub 'تعريف متغير من النوع رقم صحيح ويحمل قيمة صندوق النص Dim b As Long: b = Me.TextBox1.Value 'حلقة تكرارية لكل أوراق العمل بالمصنف For Each ws In ThisWorkbook.Sheets 'تحديد أول صف سيتم التعامل معه وإدراج الترقيم به 'لكي تجعل الترقيم يبدأ من الصف رقم 9 قم باستبدال الجملة بعد علامة يساوي بالرقم 9 lLrw1 = ws.Cells(1, "C").End(xlDown).Row + 1 'تحديد آخر صف سيتم التعامل معه وإدراج الترقيم به lLrw2 = ws.Cells(Rows.Count, "C").End(xlUp).Row 'تعريف المتغير من النوع رقم صحيح لاستخدامه في الحلقة التكرارية Dim I As Long 'حلقة تكرارية من أول صف إلى آخر صف For I = lLrw1 To lLrw2 'تم إضافة هذا السطر للخروج من الحلقة التكرارية إذا كانت الخلية في العمود الثالث فارغة If IsEmpty(ws.Range("C" & I)) Then Exit For 'وضع قيمة المتغير (القيمة التي توضع في صندوق النص) في العمود الثاني ws.Range("B" & I) = b 'زيادة قيمة المتغير الذي يستخدم في الترقيم بمقدار واحد b = b + 1 'الانتقال إلى الصف التالي داخل نفس الورقة Next I 'الانتقال إلى الورقة التالية Next ws End Sub Private Sub UserForm_Initialize() 'حدث بدء تشغيل الفورم 'يقوم الكود بتعبئة الكومبوبوكس بأسماء أوراق العمل '------------------------------------------------ 'حلقة تكرارية لكل ورقة من أوراق العمل لإضافتها إلى الكومبوبوكس For Each ws In ThisWorkbook.Sheets '[AddItem] سطر لإضافة اسم ورقة العمل إلى الكومبوبوكس من خلال استخدام الطريقة Me.ComboBox1.AddItem ws.Name 'الانتقال لورقة العمل التالية Next ws 'جعل خاصية الإندكس تساوي صفر ليظهر لك أول خيار في الكومبوبوكس 'لو حذفت هذا السطر سيظهر الكومبوبوكس فارغ إلا إذا اخترت عنصر منها بشكل يدوي Me.ComboBox1.ListIndex = 0 End Sub أرجو أن يكون الشرح مفيد ، ولا تبخل علينا بدعوات بظهر الغيب ، فما أحوجنا لتلك الدعوات تقبل تحياتي

أخي العزيز جلال محمد يبدو أنك لم تقرأ مشاركتي ( التي قمت فيها بالشرح من قبل في أول الموضوع ) بشكل جيد يجب أن يتم استخدام الفاصلة العادية بدلاً من الفاصلة المنقوطة في محرر الأكواد ولذا يجب أن يتم استبدال كل الفاصلات المنقوطة بأخرى عادية .. وليتيسر عليك الأمر اذهب لمحرر الأكواد .. اضغط Ctrl + H للاستبدال ثم قم بوضع الفاصلة المنقوطة في المستطيل الأول والفاصلة العادية في المستطيل الثاني ثم انقر على Replace All لاستبدال الكل بعدها سيظهر لك رسالة بعدد مرات الاستبدال بهذا الشكل الآن قم بتجربة الكود مرة أخرى ... ولا تنسى أن تدعو لنا بالخير تقبل تحياتي

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

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

أخي الكريم جرب الكود التالي Sub Test() Dim xlApp As Excel.Application Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True xlApp.Workbooks.Open "اكتب المسار بالكامل لملف الإكسيل المراد فتحه", True, False Set xlApp = Nothing End Sub