نجوم المشاركات

مرحبا ابو جودي ( طلبت عدم ذكر القاب وانت اهل لها ) ايش رايك نطبق محليا اولا ! وبدون سيرفر ! اقصد تنفيذ استعلام معقد محليا وهناك تاخر به وظهور بروقرس بار يبن العملية ؟ تحياتي

اخي شيفان الاولى ان لاتقيد نفسك بالتكبيق الذي استخدمة به الجملة وهي تسمى جملة التكرار فور هذه نقاط لعل لك بها فائدة 1. استفيد من الجملة في: - اريد تكرار مجموعة من الاوامر البرمجية وبتغير متغيرات بداخلها بكل لفة - قيمة العداد حيث ينحصر بين قيمتين 2. يكون العداد من الرقم الاصغر للاكبر دائما . وعند البدء بقيمة سالبة فعليك الانتباه الى ان معروف ان الرقم الاصغر باشارة سالب هو الاكبر فلو عملت فور لوب بالشكل التالي for i=-3 to 2 فاول قيمة للعداد هي -3 ثم -2 .... ثم الصفر واخيرا حتى 2 3. هناك خاصية مقدار القفز في الدوران وهي تتم باضافة step ثم قيمة القفز فمثلا for i=1 to 5 step 2 سيتم الدوران ثلاث مرات فقط لان المرة الاولى قيمة العداد 1 ثم 3 ثم 5 وحسب قيمة القفز تحياتي

السلام عليكم ورحمة الله وبركاته كود البحث المتقدم باستخدام المصفوفات VBA Arrays قدم لنا الأخ الغالي ياسر العربي صاحب الجولات والصولات كود رائع ، ويستخدم الكود في البحث المتقدم ، وقد استخدم المصفوفات والتي هي عشقي في التعامل مع الأكواد ، حيث يتم تنفيذ جميع أسطر الكود بالذاكرة بعيداً عن التعامل بشكل مباشر مع ورقة العمل ، مما يجعل الكود أسرع مئات المرات من استخدام الحلقات التكرارية العادية. وقد ارتأيت أن أقوم بشرح لأسطر الكود ليكون مرجع لكل طالب علم ولكل باحث في هذا الخصوص ، ولنبدأ مرحلة جديدة من عالم الأكواد باستخدام المصفوفات VBA Arrays ، لما لها من مرونة عالية وسرعة فائقة في تنفيذ الأكواد. يوجد بالمرفق ورقتي عمل أحدهما باسم Data وفيها البيانات الخام من 14 عمود ، والورقة الأخرى باسم Result للنتائج وبها الخلية G2 والتي توضع بها نص الكلمة المراد البحث عنها. وإليكم الكود مع الشرح بالتفصيل (وضعت مثال بسيط ليستطيع المتتبع للشرح فهم الكود بسهولة) Sub Araby_Search() 'تعريف المتغير لورقة العمل التي تحتوي على البيانات الخام Dim wsData As Worksheet 'تعريف المتغير لورقة العمـل المطلـوب إظهـار النتائـج بها Dim wsResult As Worksheet 'تعريف المتغير ليحمل قيم المصفـوفة للبيانات الخـام Dim Arr As Variant 'تعريف المتغير ليحمل قيم المصفوفة للنتائج المطلوبة Dim Temp As Variant 'تعريـف المتغير من النـوع النصي ليحمـل قيمة أو نص البحث 'أي الكلمة المطلوب البحث عنها يتم تخزينها في هذا المتغير Dim strSearch As String 'تعريف المتغير وسيستخدم في الحلقة التكرارية لصفوف المصفوفة Dim I As Long 'تعريف المتغير وسيستخدم في الحلقة التكرارية لأعمدة المصفوفة Dim J As Long 'تعريف المتغير وسيستخدم في مصفوفة النتائج لزيادة مقدار الصفوف بمقدار واحد Dim P As Long 'تعيين قيمة للمتغير ليساوي ورقة العمل التي تحتوي '[Data] على البيانات الخام المطلوب معالجتها والمسماة Set wsData = Worksheets("Data") 'تعيين قيمة للمتغير ليساوي ورقة العمل التي تريد إظهار '[G2] النتائج بها بمجرد إدخال قيمة أو نص محدد في الخلية Set wsResult = Worksheets("Result") 'مسح النطاق الذي توضع فيه النتائج استعداداً لوضع النتائج الجديدة wsResult.Range("A8:N10000").ClearContents '[G2] تعيين قيمة للمتغير ليساوي قيمة الخلية 'وهي الخلية التي ستوضع فيها نص الكلمة المطلوب البحث عنها strSearch = wsResult.Range("G2").Value 'تعيين قيمـة للمتغير ليحمل قيم النطاق بالكامل للبيانات الخام ' وذلك [Data] حيث أن مصـدر البيانات الخام ورقة العمل المسماة 'عند [N] وينتهي في العمود [A5] في النطاق الذي يبدأ من الخلية '[&] آخـر صف به بيانات ، ويتم تحديده عن طريـق الجزء بعد علامـة Arr = wsData.Range("A5:N" & wsData.Cells(Rows.Count, 1).End(xlUp).Row).Value 'والتي ستحمل قيم النتائج [Temp] إعادة تعيين أبعاد المصفوفة المسماة '[Arr] وتكون بنفس أبعاد المصفوفة التي تحمل البيانات الخام والمسماة 'سنعتبر المصفوفة أشبـه بالصفـوف والأعمدة حيث الرقـم 1 يمثـل الصفـوف 'بإرجاع أكبر قيمة [UBound]بينما الرقم 2 يمثل الأعمدة ، وتقوم الكلمة 'أبعاد المصفوفة في هذه الحالة >> '------------------------------- 'البعد الأول سيكون من 1 إلى أكبر قيمة للصفوف 'البعد الثاني سيكون من 1 إلى أكبر قيمة للأعمدة ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) 'حلقة تكرارية من الصف الأول للمصفوفة إلى آخر صف بها For I = 1 To UBound(Arr, 1) 'إذا كان النص المطلوب البحث عنه فارغ يتم الخروج من تنفيذ الكود If strSearch = "" Then Exit Sub 'هذا السطر هو أهم سطر بالكود حيث هو الشرط الذي من خلاله 'والشرط [Temp] ستوضع النتائج في مصفوفة النتائج المسماة 'هـو تطابق قيمة المصفوفة في صف الحلقة في العمود رقم 14 'حيث يمثـل الرقم 14 العمود داخـل مصفوفة البيانات الخام '[strSearch] يتـم اختبـار التطابـق مع نـص البحث المسمى If Arr(I, 14) Like "*" & strSearch & "*" Then 'زيادة مقدار المتغير بمقدار 1 'فائدة المتغير هنا هو أنه مع كل حلقة تكرارية 'إذا تحقق الشرط فقط يزيد المتغير بمقدار واحد 'ليمثل هذا المتغير صفوف مصفوفة النتائج الجديدة P = P + 1 'حلقة تكرارية داخلية من العمود الأول للمصفوفة إلى آخر عمود بها For J = 1 To UBound(Arr, 2) 'تعبئـة مصفـوفة النتائـج بالبيانات مـن مصفوفة البيانات الخام '[Temp]مثـال لتتضح صورة كيفية تعبئة المصفوفة الجديدة المسماة 'في أول حلقـة سيكون مقداره 1 ويمثل أول صف [P] المتغيـر المسمى 'أول صف هنا لمصفوفة النتائج 'في أول حلقة سيكون مقداره 1 ويمثل أول عمود [J] المتغير المسمى 'في أول حلقة سيكون مقداره 1 ويمثل أول صف [I] المتغير المسمى 'أول صف هنا لمصفوفة البيانات الخام Temp(P, J) = Arr(I, J) 'الانتقال للحلقة التالية للأعمدة Next J 'نهاية جملة الشرط وهو تطابق نص البحث مع العمود رقم 14 في المصفوفة End If 'الانتقال للحلقة التالية في صفوف مصفوفة البيانات الخام Next I 'إذا كانت قيمة المتغير أكبر من صفر فهذا يعني أنه تم إيجاد نتائج للبحث 'حيث أن زيادة المتغير كما أوضحنا مقرونة بتحقق الشرط وطالما تحقق الشرط 'فهذا يعني أن مصفوفة النتائج سيكون بها بيانات ومن ثم يتحقق الجزء الثاني '[A8] وضع نتائج مصفوفة النتائج في أول خلية في ورقة النتائج في الخلية '[P] ويتم تمديد النطاق بمقدار عدد الصفوف طبقاً لقيمة المتغير المسمى '[Temp] وبمقدار عدد الأعمدة طبقاً لأكبر عدد لأعمدة المصفوفة المسماة If P > 0 Then wsResult.Range("A8").Resize(P, UBound(Temp, 2)).Value = Temp End Sub لتحميل الملف المرفق وللإطلاع على الموضوع الأصلي قم بزيارة الرابط التالي رابط الموضوع من هنا

فكرة حلوة ويمكن الاستمرار بان ياخذ الامر نص الاختيار عنوانا Private Sub cmb_Committe_AfterUpdate() btn_DropCommittee.Caption = cmb_Committe End Sub بالتوفيق

اخي عبدالعزيز هذا المطلوب ختلف عن المطلوب باول مشاركة ! واعتقد ان الاستاذ شيفان اجاب على اخر طلب وهناك فكرة ان تربط الترقيم بان السجل جديد ليصبح كود بعد التحديث لاسم ولي الامر كالتالي Private Sub FATHER_NAME_AfterUpdate() Rem تعبئة حقول محددة من مربع الالتحرير والسرد ' Me.SONS = Me.FATHER_NAME.Column(1) ' Me.PHONE = Me.FATHER_NAME.Column(2) ' Me.INSTALLMENTS = Me.FATHER_NAME.Column(3) Rem ترقيم آلي If Me.NewRecord Then Me!NUM_PAID = Nz(DMax("[num_Paid]", "[TabPaids]"), 0) + 1 End Sub بالتوفيق

بقالى نصف ساعة على الصفحة عشان اعمل مشاركة النت سلحفاة اضافة الى كلام أستاذى الفاضل جرب الكود التالى على ملفك الكود يؤكد أن المسافة الفارغة لها قيمة عند اكسل Sub Test2() Dim Cel As Range For Each Cel In Range("A2:A29") Cel.Offset(, 3).Value = Len(Cel) & " " & " حرف بالمسافات" Cel.Offset(, 4).Value = Len(Replace(Cel, " ", "")) & " " & "حرف بدون المسافات" Next Cel Cells.ShrinkToFit = True End Sub

الاحتمالات.rar

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

وانت انسان حساس وبما ان القلب الطيب بطبيعته يتواجد داخل الانسان الحساس فانت انسان طيب مدح على شكل كود

انت انسان رائع

حبيبي ابو البراء معلش بقى مكان ما تحط تشفيرك احط تشفيري تفضلو تشفير كل انواع الملفات ولا يستطيع احد فتحها من الخارج http://yasserelaraby86.blogspot.com.eg/2016/04/blog-post_24.html تقبل تحياتي

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

السلام عليكم ورحمة الله تعالى وبركاته اساتذتى الافاضل اولا اعتذر لعدم توفير مرفق السؤال بخصوص الشريط التقدمة التفاعلى الــــ "ProgressBar" لو قاعدة البيانات على سيرفر عند تنفيذ استعلام ما يأخر من الوقت حوالى من 15 ثانية الى 30 ثانية حسب كم البيانات التى يتم الفلترة عليها وحسب امكانيات المعالج وبعد المسافة احيانا عن السويتش.... هل يمكن عمل ProgressBar يعمل فى نفس فترة تحضير الركويرى اى يكون مرن بمرونه البدء فى الكويرى وينتهى حسب الانتهاء من الكويري دون التقييد بوقت محدد فى الكود غير ان ال ProgressBar اما يبدا قبل الكويرى او بعد الكويرى هههههه حد فهم حاجة

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

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

في هذا الملف البيانات في صفحة اخرى اخي ياسر ليس من الضرورة لهكذا معادلة طويلة (نسيت ان اضرب النتيجة بقيمة الخلية b&12 $ ) لتصبح هكذا =INDEX($A4:$I4,2*(COLUMNS($A$1:A1)-1)+3)*(1+$B$12) النسخ salim.rar

ههههههههههههههه ربنا ما يحرمنا من لمساتك الرمهانية جزاكم الله خيرا دائما وابدا هناك لمسات رمهانية وادى المرفق الرمهانى Test_2.rar

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

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

هل من حل لمشكلة ظهور #Type! فى الحقول الفارغة اثناء البحث SearchHighlight.rar

جزاكم الله خيرا طيب ممكن طلب انا بصراحة كنت باحاول البحث عنه من تلقاء نفسى دون الرجوع اليكم والاثقال عليكم حياء منكم وبخاصة فى هذا الموضوع ولكن انت البادئ ههههههههه هل هناك طريقة لوضع ذلك التعبير =IIf(IsNull([txtSearch2]),[E_mail],IIf(IsNull([e_mail]),"",Replace([E_mail],[txtSearch2],"<font color=red>" & [txtSearch2] & "</font>"))) فى كود ليصلح لكل الحقول ام يجب عمل تعبير لكل حقل على حدة

تفضل اخي العزيز ارجو ان يكون طلبك asd.rar

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

وعليكم السلام أخي الكريم وائل جرب الكود التالي .. وحاول أن تضع شكل المخرجات إذا لم يؤدي الكود الغرض Sub Test() Dim Cel As Range For Each Cel In Range("A1:A29") If Len(Cel) >= 255 Then Cel.Offset(, 1).Value = Cel.Value Cel.ClearContents End If Next Cel End Sub

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

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

السلام عليكم الله يرضى عليك استاذ ياسر جزيت خيرا

السلام عليكم برأيي اخي الكريم يجب عليك انشاء قاعدة بيانات جديدة ثم تقوم باستيراد كل العناصر من القاعدة القديمة الى الجديدة

السلام عليكم كيف حال الاخوة الكرام اخ وائل ارسلت لك اميل ارجو الاطلاع عليه بالنسبة للبرنامج تظهر لي الكثير من رسائل الخطا هل الامر يحدث معك ايضا

مشكور اخي الكريم جلال على اهتمامك بالموضوع واعادة نشره مستقل تقبل تحياتي

على الرغم ان المشاركة يعود لسنة 2008 لكن هذا جواب لهذا في ورقة خصائص النموذج في التنسيق format غير ارتفاع الشبكة و عرض الشبكة الى رقم 10 مثل هدول الصور ... عفوا مرة الاخرى لكن جوبت على هذا لكي يستفيد منه الجميع اخوكم شفان ريكاني

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

كود لاظهار الشيتات المخفية فى اكسل Sub UnhideAll() Dim WS As Worksheet For Each WS In Worksheets WS.Visible = True Next End Sub مرفق ملف به التطبيق اظهار الشيتات المختفية.rar

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

مرحبا تقريا نفس الكود الذي وضعه اخي ياسر Sub ColorRange() Application.ScreenUpdating = False Dim c1 As Range, c2 As Range Range("b3:i16").Interior.ColorIndex = xlNone: Range("b3:i16").Font.ColorIndex = 1 For Each c1 In Range("b3:i16"): For Each c2 In Range("b3:i16") If Val(c1.Value) + Val(c2.Value) = Range("a2").Value Then x = Int(Rnd * 55) c1.Interior.ColorIndex = Val(x): c2.Interior.ColorIndex = Val(x) End If If c1.Value = Range("a2").Value Then c1.Font.ColorIndex = 46 If c2.Value = Range("a2").Value Then c2.Font.ColorIndex = 46 Next Next Application.ScreenUpdating = True End Sub

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

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

وعليكم السلام قم بسحب المعادلة في الملف الذي أرفقته إلى آخر المدى المطلوب .....

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

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

جزاكم الله خيرًا على سرعة الاستجابة وجارى التجربه ...... جعله الله فى ميزان حسناتكم

you welcome in times to come, please try to choose a suitable name for the subject because it bases posts in forums and we must all respect for those rules do not put your address is not suitable for the subject, as it did and you would have your own e-mail regarding the arabization list you can search the internet for the arabization of office suit version you are using, and so are all the menus to translate the arabic language that you want it as he can switch between languages when you want to after that with ease

ربما يكون هذا الكود (المرفق)اسرع قليلاً SERCH_ARRY salim.rar

أخي الغالي مختار حسين تفضل باستخدام المصفوفات Sub Using_Arrays() Dim Arr As Variant Dim Temp As Variant Dim I As Integer Dim J As Integer Dim P As Integer Dim Cnt As Integer Dim tSum As Double Range("C6:I9").ClearContents Arr = Range("L5:R9").Value ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2) + 1) For I = 2 To UBound(Arr, 1) Cnt = 0: tSum = 0 For J = LBound(Arr, 2) To UBound(Arr, 2) If Not IsEmpty(Arr(I, J)) Then Temp(I - 1, Cnt + 1) = Arr(I, J) Temp(I - 1, Cnt + 2) = Arr(1, J) tSum = tSum + Arr(I, J) P = P + 1 Cnt = Cnt + 2 End If Next J Temp(I - 1, UBound(Temp, 2) - 1) = tSum Cnt = Cnt + 2 Next I Range("C6").Resize(UBound(Temp, 1), UBound(Temp, 2)).Value = Temp End Sub

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

أخي الغالي ياسر في نافذة Pivot Table Fields روح للحقل المسمى Billing Date واعمل كليك عليها هيظهر لك قائمة اختر منها Field Settings هيظهر لك نافذة فيها كلمة Number Format روح للقسم Custom واكتب mmm تقبل تحياتي

الأخ الحبيب ياسر جرب الملف التالي ... بحماية الورقة Restrict Cursor Movement To Unprotected Cells.rar

الاخ الفاضل الاستاذ المحترم / عبد الله المجرب السلام عليكم ورحمة الله وبركاتة برجاء قبول هذه المشاركة البسيطة بعدما يتم تحديد كافة الخلايا وازالة التامين عنها بالكامل كما تفضل الاستاذ / عبد الله بالاشاره اليه لتحديد جميع الخلايا ذات الصيغ يتم الضغط علي مفتاح F5 ثم اختيار (خاص - بعدها نختار صيغ ) ثم نقوم بتامين الخلايا التي قام الاكسيل بتحديدها وهي هنا الخلايا ذات الصيغ والمعادلات شكرا

اذن اخي من الاحسن ان تستعمل هذ الكود الذي طرحته في مشاركة سابقة Private Sub Worksheet_Selectionchange(ByVal Target As Range) If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select ElseIf Target.MergeCells = True And Target.HasFormula = True Then Target.Offset(0, 1).Select ElseIf ActiveCell.HasFormula = True And ActiveCell.MergeCells = True Then ActiveCell.Offset(0, 1).Select End If End Sub