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

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

اخي شيفان الاولى ان لاتقيد نفسك بالتكبيق الذي استخدمة به الجملة وهي تسمى جملة التكرار فور هذه نقاط لعل لك بها فائدة 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 اما يبدا قبل الكويرى او بعد الكويرى هههههه حد فهم حاجة

السلام عليكم استفدت مؤخرا بكود ممتاز لـ TEXT BOX أمكنني من البحث بمجرد كتابة الحرف الأول فقط ... للأسف لا أذكر من صاحبه لأشكره على مجهوده. المطلوب تعديل لهذا الكود بحيث يبحث عن الكلمة في كل الخلية وليس الأحرف الابتدائية لها فقط . الكود هو : Private Sub TextBox1_Change() Dim lastrow As Long lastrow = Range("N65535").End(xlUp).Row If ActiveSheet.TextBox1.Text <> "" Then Range("$A$2:$R$" & lastrow).AutoFilter Field:=14, Criteria1:= _ "=" & TextBox1.Text & "*", Operator:=xlOr Else Range("$A$2:$R$" & lastrow).AutoFilter Field:=14, Criteria1:= _ "=" & ActiveSheet.TextBox1.Text & "*", Operator:=xlOr End If End Sub ولكم جزيل الشكر

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

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

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

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

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

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

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

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

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

ما شاء الله كود ولا أروع ، وسرعة ما لها حل .... وصدق أخي @قلم-الاكسل(عبدالعزيز) فلا ندري نشكر من صاحب الشرح أم صاحب الكود ! فالشكر للاثنين معا جزاهم الله خيرا وزادهما من علمه

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

الله يرضى عليكم جميعا وعلى هذا المنتدى الرائع

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

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

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

وعليك السلام أخى الحبيب حسام أنا في العمل الآن والجيميل لا يفتح معى حالما ارجع للبيت خلال ساعتين إن شاء الله سأطلع على الميل أما بالنسبة لاستفسارك عن البرنامج فلا أعرف أى البرنامجين تقصد ولا طبيع ونوع الخطأ الذى يظهر وعموما فإذا كان البرنامج القديم 29-9-2016 Trip To Paradise فقد كان يعمل دون رسائل خطأ وأما إن كان برنامجك الجديد Foaid2 فقد لاحظت وأن أعمل عليه بعض الملاحظات منها أنه ليس به علاقات بين جداول العناوين وأنك أذا حذفت العناوين لتصفير الترقيم التلقائى وعمل ضغط وإصلاح لقاعدة البيانات ووضعت عناوين جديدة في جداول العناوين فالشجرة لا تعمل وتعطى بعض رسائل الخطأ في بنيه الكود

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة تشفير وفك تشفير البيانات Encrypt And Decrypt Function تم ارفاق ملف جديد لنفس الموضوع من الفاضل _ أ / ياسر العربى تفضلو تشفير كل انواع الملفات ولا يستطيع احد فتحها من الخارج http://yasserelaraby86.blogspot.com.eg/2016/04/blog-post_24.html و لا تنسونا من صالح الدعاء تحياتى الاحتمالات.rar

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

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

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

اتفضل اخي حسب فهمي لطلبك اذا بيكون رقم السند موجود ما يتغير الرقم السند حين تم تعديل على اسم واذا بيكون فارغ راح يزيد رقم واحد على اخر رقم واذا تريد تتغير رقم السند ما تكدر الا برقم سري الا وهو 0000 واذا دخل رقم خطا راح يكلك الرقم سري خطأ ولا تكدر تتغير رقم السند مع شكر وتقدير اخوك : شفان ريكانى Aziz.rar

كود لاظهار الشيتات المخفية فى اكسل 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

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

جزيت خيرا اخي الغالي ابو البراء على الشرح الوافي تقبل تحياتي

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

- المطالبة ببيانات الشركة / المؤسسة عند فتح القاعدة للمرة الاولى - نسخة تجريبية للسنة الحالية فقط حتى لو تم التلاعب بتاريخ النظام بالتقديم والتاخير فى شاشة اتفاقية الترخيصعند الضغط على الرز (F6) سوف تتم فتح نافذة لو تم تغيير التاريخ الى الى سنة 2016سوف يعمل البرنامج بنجاح - اخفاء اطارات الاكسس - انشاء مجلدات تخص نظم قاعدة البيانات -مشاركة الصور بحفظ مسارتها داخل المجلد الخاص بها بنفس مسار القاعدة -عرض الصور على الشبكة دون تغييرها او تغيير مسارها او تعديله او دون اى تدخل من المبرمج بدون عناء ( تصلح لصور الموظفين) تم ادراج نموذج يتحكم بكل صغيرة وكبيرة فى القاعدة لزيادة الحماية ملحوظة : القاعدة لن تعمل عند محاولة تغيير اسمها لم اخفى كل كائنات القاعدة بلا رجعة لم اقم بغلاق زر الشيفت demo.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