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

السلام عليكم ورحمة الله وبركاته كود البحث المتقدم باستخدام المصفوفات 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 لتحميل الملف المرفق وللإطلاع على الموضوع الأصلي قم بزيارة الرابط التالي رابط الموضوع من هنا

السلام عليكم ورحمة الله وبركاته هل لديك بيانات حساسة ومهمة في ورقة العمل تريد ألا يطلع عليها أحد؟ طرق الحماية للإكسيل كما يعرف الجميع ضعيفة ، لذا فإن تشفير البيانات هو الحل الأمثل للوصول إلى حماية أفضل للبيانات. إخواني الكرام أقدم لكم طريقة لتشفير البيانات في ملفك ، وبنفس الكود ستتمكن من فك تشفير البيانات. خطوات العمل : >> قم بالدخول لمحرر الأكواد عن طريق Alt + F11 ، ثم من قائمة Insert أدرج موديول جديد Module ، وأخيراً الصق الكود التالي داخل الموديول. >> قم برسم زر أمر على ورقة العمل ، ثم كليك يمين على الزر واختر الأمر Assign Macro ثم اختر الإجراء الفرعي المسمى Encrypt_Decrypt Sub Encrypt_Decrypt() Dim xRg As Range Dim xPsd As String Dim xTxt As String Dim xEnc As Boolean Dim xRet As Variant Dim xCell As Range On Error Resume Next xTxt = ActiveWindow.RangeSelection.Address Set xRg = Application.InputBox("Select A Range:", "Select Range To Encrypt / Decrypt", xTxt, , , , , 8) Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange) If xRg Is Nothing Then Exit Sub xPsd = InputBox("Enter Password:", "Pass Entry") If xPsd = "" Then MsgBox "Password Cannot Be Empty", , "Kutools For Excel" Exit Sub End If xRet = Application.InputBox("Type 1 To Encrypt Cell(s)" & vbNewLine & vbNewLine & "Type 2 To Decrypt Cell(s)", "Encrypt = 1 / Decrypt = 2", , , , , , 1) If TypeName(xRet) = "Boolean" Then Exit Sub If xRet > 0 Then xEnc = (xRet Mod 2 = 1) For Each xCell In xRg If xCell.Value <> "" Then xCell.Value = Encryption(xPsd, xCell.Value, xEnc) End If Next xCell End If End Sub Private Function StrToPsd(ByVal Txt As String) As Long Dim xVal As Long Dim xCh As Long Dim xSft1 As Long Dim xSft2 As Long Dim I As Integer Dim xLen As Integer xLen = Len(Txt) For I = 1 To xLen xCh = Asc(Mid$(Txt, I, 1)) xVal = xVal Xor (xCh * 2 ^ xSft1) xVal = xVal Xor (xCh * 2 ^ xSft2) xSft1 = (xSft1 + 7) Mod 19 xSft2 = (xSft2 + 13) Mod 23 Next I StrToPsd = xVal End Function Private Function Encryption(ByVal Psd As String, ByVal InTxt As String, Optional ByVal Enc As Boolean = True) As String Dim xOffset As Long Dim xLen As Integer Dim I As Integer Dim xCh As Integer Dim xOutTxt As String xOffset = StrToPsd(Psd) Rnd -1 Randomize xOffset xLen = Len(InTxt) For I = 1 To xLen xCh = Asc(Mid$(InTxt, I, 1)) If xCh >= 32 And xCh <= 126 Then xCh = xCh - 32 xOffset = Int((96) * Rnd) If Enc Then xCh = ((xCh + xOffset) Mod 95) Else xCh = ((xCh - xOffset) Mod 95) If xCh < 0 Then xCh = xCh + 95 End If xCh = xCh + 32 xOutTxt = xOutTxt & Chr$(xCh) End If Next I Encryption = xOutTxt End Function شرح كيفية استخدام الكود : لتشفير البيانات : حدد النطاق أو الخلايا المراد تشفير البيانات بها ، انقر على زر الأمر ليظهر لك صندوق إدخال يمكنك من خلاله تحديد النطاق ، وبما أنك قمت بتحديد النطاق في البداية فلن يكون لديك سوى أن تنقر OK ، لتنتقل إلى صندوق إدخال آخر بعنوان Pass Entry ومن خلاله تدخل كلمة السر للتشفير ، وليكن 111 ، ثم انقر OK الآن سيظهر آخر صندوق إدخال وهو لإدخال الرقم 1 (للتشفير) ، أو الرقم 2 (لفك التشفير) بما أننا نريد التشفير سنقوم بكتابة الرقم 1 ثم ننقر OK ، ولاحظ البيانات في النطاق (لقد تم الأمر بحمد الله) لفك التشفير : ستقوم بتكرار نفس الخطوات بالضبط وتدخل نفس كلمة السر ، وفي آخر صندوق إدخال ستقوم بإدخال الرقم 2 لفك التشفير وأخيراً إليكم صورة توضيحية لكيفية التعامل مع الكود لتحميل الملف المرفق قم بزيارة الرابط للموضوع رابط الموضوع من هنا

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

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

فعلا فى جدول باسم tab1 لكن انا لازلت احاول اظهاره او استخراج المعلومات منه الباسورد على vba كان بالاسكى كود تقريبا

بسم الله الرحمن الرحيم " الْحَمْدُ لِلّهِ الَّذِي هَدَانَا لِهَذَا وَمَا كُنَّا لِنَهْتَدِيَ لَوْلا أَنْ هَدَانَا اللّهُ " ============================================================ برنامج الكنترول المدرسى 2017 من فضلك أكمل قراءة الموضوع ــ روابط التحميل آخر الموضوع نبذة عن البرنامج أولاً ـ تم تصميم وإعداد هذا البرنامج باستخدام Office 2010 ، لذلك فالبرنامج لا يعمل على Office 2003 ثانيًا ـ يعتبر هذا البرنامج الاصدار الثانى بعد نجاح الاصدار الأول بفضل الله ـ عز وجل ـ و الذى أعجب به كثير من رواد الكنترولات لبساطته وسهولة التعامل معه ولكن وجد به بعض التعديلات التى وجبت علىّ متابعتها وتعديلها وإظهار الأفضل والأدق ، فكان هذا الاصدار الثانى . الجديد في هذا الاصدار : 1ـ استخدام تصميمات جذابة سواء في أوراق العمل أو في وجهات البرنامج المختلفة . 2ـ يتم الانتقال بين أوراق الكنترول باستخدام أزرار داخلية المساعدة و من خلال الوجهات للدخول غلى أوراق العمل . 3 ـ تم تخصيص ورقة لتجهيز وإعداد وضبط وفرز أسماء التلاميذ وترتيبهم ابجديا ( الذكور أولا ) أو ( الإناث أولا) يتم الترحيل منها إلى البيانات الأساسية للطلاب 4ـ وتم إضافة خيار جديد داخل قائمة ( حالة الطالب ) وهو منقطع العام السابق إذا كان الطالب غائب عن الامتحان العام السابق فقط ( منقطع عام واحد ) وذلك لحساب عدد الطلاب الموقوف قيدهم للانقطاع عامين بعد الدور الثانى . 5 ـ في كثير من أوراق العمل متابعة تعليمات التشغيل من خلال ( ملاحظات ) موجودة داخل كل ورقة عمل . 6 ـ وجود إحصائيات داخل أوراق العمل للمساعدة مسئول الكنترول على متابعة العمل. أولا بأول 7ـ كشوف المناداة يحتوى كل كشف على لجنتين من نفس الصف الدراسى . 8 ـ الجدول وأرقام الجلوس : يوجد بالجدول الأول بالورقة قوائم منسدلة لملء بيانات الجدول فمثلا : خانة اليوم .... اضغط ستجد قائمة بأيام الأسبوع. خانة المادة ... اضغط ستجد قائمة بأسماء المواد الدراسية . خانة الزمن .. اضغط ستجد قائمة بأوقات الامتحان المتاحة . 9 ـ يتم ترحيل الطلاب الراسبين أو الناجحين تلقائيًا إلى أوراق منفصلة بهم خاصة 10 ـ زادت دقـــة الاحصائيات عن الاصدار الأول وتعديل ما بها من قصور بسيط . 11 ـ تم استخراج نسبة 65 % للطلاب الناجحين للمواد مرفقة داخل ورقة الاحصاء . 12 ـ تم تعديل شروط الحصول على الأوائل لتكون أكثر دقــة وذلك بالشروط المنصوص عليها وهى : الأكبر مجموع ثم الأصغر سنا في حالة تساوى المجموع ثم الترتيب الأبجدى في حالة تساوى المجموع والسن . ـ وظهور كلمة مكرر في حالة التساوى . 13 ـ يمكن التحكم في عدد الأوائل 30 أو 20 أو 10 حسب الرغبة وذلك باستخدام أزرار معينة موجودة بورقة العمل . 14 ـ تم تعديل هيكل تصميم الشهادات ليوافق التصميم المتعارف عليه والمنصوص عليه . 15 ـ يمكن الحصول على شهادات بأكثر من شكل كما يلى :_ __ شهادة التيرم الأول بمجموع المواد الأساسية فقط __ شهادة التيرم الأول بالمجموع الكلى بالأنشطة ـ __ شهادة التيرم الأول بدجات الامتحان التحريرى ـ __ شهادة التيرم الثانى بمجموع المواد الأساسية فقط __ شهادة التيرم الثانى بالمجموع الكلى بالأنشطة ـ __ شهادة التيرم الثانى بدجات الامتحان التحريرى ـ 16 ـ : الدور الثانى : _ يتم ترحيل البيانات من شيت راسبين آخر العام إلى ورقة البيانات الأساسية للطلاب الدور الثانى تلقائيا . 17 ـ يتم ترحيل الدرجات الناجحة فقط إلى كشف رصد الامتحان التحريرى الدور الثانى ويتبقى خانات فارغة التى تخص الدرجات الراسبة التى يتم الامتحان فيها ورصدها . 18 ـ يوجد إحصاء ختامى لنهاية العام الدراسى . 19 ـ يوجد أوراق منفصلة كل على حده لما يأتى : _ أ ـ كشف الناجحين بعد الدور الثانى . ب ـ كشف الراسبين بعد الدور الثانى . ج ـ كشف المنقولين بحكم القانون بعد الدور الثانى . د ـ كشف الموقوف قيدهم للانقطاع عامين بعد الدور الثانى . 20 ـ تم إضافة أوراق جديدة للكنترول للمساعدة على أداء العمل : وهذه الأوراق هى أ ـ كشف إجمال براسبين التيرم الثانى لتوقيع ولى الأمر بالعلم . ب ـ إخطار ولى الأمر رسميا من المدرسة بالدور الثانى للطالب . ج ـ أوراق خاصة برئيس الكنترول ( تشكيل لجنة الكنترول ـ إقرار موانع الامتحان ـ تعليمات سير الامتحانات ) . د ـ محضر فتح مظاريف أوراق الأسئلة . هـ ـ محضر فتح / غلق الكنترول . و ـ محضر تصحيح أوراق الاجابة . ز ـ كشف إجمالى بتوزيع اللجان من الصف الأول إلى الصف الخامس ( خاص بالكنترول ) =================================================================== وأخيـــــــــــــرًا فى حالة وجود أى قصور أو مقترحات واستفسارات عن البرنامج يرجى التواصل معنا عبر خطوط التواصل المختلفة سواء أرقام الهاتف المحمول أو البريد الإلكترونى أو الصفحة الرئيسية على موقع التواصل الاجتماعى الفيس بوك ـــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ مع تحياتى محمد إبراهيم الدسوقى معلم أول ( أ ) حاسب آلى محافظة الغربية ـ إدارة سمنود التعليمية مدرسة أم المؤمنين الابتدائية ـ بالراهبين 01125915740 // 01274757320 @@@@@@@@@@@@@@@@@@@@@@@ E.mail : me.100100@yahoo.com Facebook_Pro. : Mohamed Eldesoky @@@@@@@@@@@@@@@@@@@@@@@ والآن مع روابط التحميل : الصف الأول الابتدائى هنــا الصف الثانى الابتدائى هنــا الصف الثالث الابتدائى هنــا الصف الرابع الابتدائى هنــا الصف الخامس الابتدائى هنــا @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ السلام عليكم ورحمة الله

السلام عليكم ورحمة الله تفضل المصنف.rar

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

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

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

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

كود يقوم باخفاء الاعمدة A:N اذا كانت الخلايا في الصف الثاني تساوي صفر قم بتعديله بما يناسبك Sub HideClms() Dim i As Integer Columns("A:N").Hidden = False For i = 1 To 15 If Cells(2, i) = 0 Then Columns(i).EntireColumn.Hidden = True Next End Sub

الشرح المستفيض لكود البحث المتقدم باستخدام المصفوفات للأستاذ الكبير ياسر العربي Search Using Arrays http://adf.ly/1efc1m

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

استخدمت جميع البرامج لاظهار باسوورد قاعدة البيانات لكنها لم تظهر !!!!!!!!!!!!!!!!!!!!!! يعني لازلت في الشوط الاول

بعد اذن أستاذى ياسر تفضل أستاذ محمد الكود : Option Explicit Sub GetNumber() ' Author : Mokhtar ' Release : 8 - 10 - 2016 ' split and convert numbers stored as text numbers '-------------------------------------------------- Dim C As Range Dim Rng As Range Dim I As Long Dim N As Long Dim S As String Dim Arr As Variant Application.ScreenUpdating = False Range("C2").Resize(4).ClearContents For I = 2 To 5 S = Range("B" & I) Arr = Split(S, " ") Cells(I, 4).Resize(1, UBound(Arr) + 1) = Arr Next I Set Rng = Cells(2, 4).CurrentRegion For Each C In Rng.Cells C.Value = WorksheetFunction.Text(C, 0) If IsNumeric(C.Value) = True Then If C.Value > 0 Then N = N + 1 ReDim Preserve Arr(1 To N) Arr(N) = CDbl(C.Value) End If End If Next C Rng.ClearContents Range("C2").Resize(UBound(Arr, 1), 1) = Application.Transpose(Arr) Erase Arr Set C = Nothing Set Rng = Nothing Application.ScreenUpdating = True End Sub تحياتى

السلام عليكم ورحمة الله أخي الحبيب أبو حنين، أقترح أن تستعمل الدالة WEEKNUM مع اختبار شفعية العدد (زوجي أم فردي) الذي تعطيه هذه الدالة ثم إعطاء الحرف A (لرقم الأسبوع الفردي مثلا) والحرف B (لرقم الأسبوع الزوجي مثلا)... والله أعلم المعادلة التالية يمكن تفي بالغرض المطلوب: =IF(MOD(WEEKNUM($A$1;14);2)=1;"A";"B") بن علية

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

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

الحمدلله وبعد جهد جهيد وجدت ضالتي في هذه الساعة، وبالرغم من توفر بعض الساعات النادرة في ملفات الإكسيل، إلا أنها تعيبها بعض الأمور منها: 1- عمل الساعة في الخلفية مما يعطل تنفيذ بعض الأوامر وتجميد ورقة العمل. 2- رتابة التصميم. 3- عدم توافقها لبعض إصدارات الإكسيل والوندوز. ولذلك تم تفادي هذه المشاكل مع إمكانية التصميم المرن للساعة حيث أننا فصلنا كل رقم من الساعة (digit) ليعمل بشكل منفصل ومترابط مع الأجزاء الأخرى، وكل من يشاهد التصميم يتوق بأنه قد تم برمجته بلغات الويب المتقدمة كالجافا.. نتمنى أن ينال إعجابكم ولا تنسونا من الدعاء clock03.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

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

بعد التجربة اتضح أنه يؤثر على الخلايا التي بها معادلات ..عموماً بسيطة قم بتعديل السطر التالي في الكود For Each xCell In xRg.SpecialCells(xlCellTypeConstants)

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

السلام عليكم ورحمة الله وبركاتة تحية طيبة وبعد ,,,, هل من الممكن ان يكون بهذا الشكل و في حالة انك تريد شكل اخر يمكنك الاختيار بين اشكال و لكن اشكال محدودة كالاتي : الملف المرفق بالرد القادم المصنف.rar

فكرة جميلة جدا مع بعض الاضافات تصبح قائمة حقيقية احسنت Test2.rar

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

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

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

سلاو كاك شيڤان ده‌ست خۆش بۆ وه‌لامه‌كه‌ت به‌لام من ده‌مه‌ويت ئۆفيسى عربى به‌كار نه‌هينم وه‌ ده‌مه‌ويت كليكى راست بكه‌م به‌ كوردى ته‌نها له‌ اكسسدا وه‌ بينيومه‌ كراوه‌ ئه‌گه‌ر حه‌زت كرد وينه‌يه‌كت بۆ ده‌نيرم كه‌ كردويانه‌ به‌لام نازانم چۆن كراوه‌ ... له‌گه‌ل ريزم سلاو كاك شيڤان ده‌ست خۆش بۆ وه‌لامه‌كه‌ت به‌لام من ده‌مه‌ويت ئۆفيسى عربى به‌كار نه‌هينم وه‌ ده‌مه‌ويت كليكى راست بكه‌م به‌ كوردى ته‌نها له‌ اكسسدا وه‌ بينيومه‌ كراوه‌ ئه‌گه‌ر حه‌زت كرد وينه‌يه‌كت بۆ ده‌نيرم كه‌ كردويانه‌ به‌لام نازانم چۆن كراوه‌ ... له‌گه‌ل ريزم

أشكرك أخى و أستاذى الغالى جارى التحميل ولا شك فى النتيجة قبل التجربة المرفق تعديل للمرفق السابق تم اضافة تنسيقات و بعض التعليقات على الكود تحياتى split string from number stored as text Mokhtar 2.rar split string from number stored as text Mokhtar 2.rar

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

يا سلام من غير ما تقول أخى و أستاذى Option Explicit Sub GetText() ' Author : Mokhtar ' Release : 8 - 10 - 2016 ' split Text from numbers stored as text numbers '-------------------------------------------------- Dim C As Range Dim FC As Range Dim Rng As Range Dim SRng As Range Dim I As Long Dim N As Long Dim S As String Dim Arr As Variant Dim StrStart As String Application.ScreenUpdating = False Range("D2").Resize(4).ClearContents For I = 2 To 5 S = Range("B" & I) Arr = Split(S, " ") Cells(I, 6).Resize(1, UBound(Arr) + 1) = Arr Next I Set SRng = Cells(2, 6).CurrentRegion For Each C In SRng.Cells C.Value = WorksheetFunction.Text(C, 0) If IsNumeric(C.Value) = True Then C.ClearContents Next C For N = 2 To 5 Set Rng = Range("F" & N, "Z" & N) Set FC = Range("D" & N) For Each C In Rng StrStart = C C.ClearContents FC = Trim(Replace(FC, FC, "") & " " & FC & " " & StrStart) Next C Next N Application.ScreenUpdating = True End Sub وده ملف التطبيق بالمرة عشان منحرمش الكسالى split string from number stored as text Mokhtar.rar

ممكن ترسم على الورق اللي حضرتك تريد لكي نفهم اكثر ما تريد مع تحياتي

ماشاء الله عليك ابا جودي اذا عرف اسم الجدول اليس الامر التالي كفيل بفتحه docmd.opentable جرب لاني اريد ان اصل لحاجة في بالي

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

مشكور أخي الكريم أبو يوسف النجار على مرورك العطر وردك الطيب

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

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

يمكن ان يكون التعبير التالي في خاصية القيمة الافتراضية للعنصر رقم المورد بالنموذج =DMax("[كود المورد]","الموردين")+1 بالتوفيق

تفضل اخي العزيز scona store 3.rar

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

احسنت اخي محمد ورحم الله والديك على التوضيح

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

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

ودى فكرة تانية مع اخوية حسام تعتمد على نقل التركيز ممكن اخفاء العنصر لو حضرتك عاوز النموذج بنفس الشكل وللعلم فكرة الاستاذ حسام لم تعمل معى على اكسس 2016 Test.rar

مشكورين جميعا اخواني لمروركم الكريم تقبلو خالص تحياتي اما بخصوص البحث بشروط تفضلو التعديل بحث باي شرط الى شرط التاريخ كما طلب الاخ عاطف وشكرا SERCH_ARRY_YASSER_ELARABY1.rar

العفو .. اللهم أميييييين

السلام عليكم وكل عام انتم بخير عيدكم مبارك أولا - عود أحمد ( رد بعد حوالى أربعة أشهر أعتقد أن هذا يتطلب تسجيل بموسوعة جنيس للأرقام القياسية - طبعا الموسوعة اللى عندنا بالصعيد مش بتعاعت بلاد برة -) ثانيا - سامحنى فقد نسيت الموضوع , وقد راجعت الاستفسار الأصلى والردود عليه بشكل سريع لأتذكر - ماذا حدث فى مثل هذا اليوم - فوجد بعض الاستفسارات المطروحة ولم ترد عليها وبعض الاستفسارات التى تم الرد عليها باجابات تحتاج لاعادة صياغة الاستفسار مرة أخرى ليتناسب مع الجواب الجديد. الا أنى أحيى فيك هذه الروح المثابرة - لذا أرجو توضيح الاستفسارات المطروحة آنفا لعلها تساعدنا فى تصحيح مسار الجواب - السؤال بشكل آخر هل أسماء الطلاب سيتم ملأها بشكل يدوى فى التقرير بعد الطباعة مثلا , أم ستظل فارغة - وإن كانت ستظل فارغة هل وجود الرقم المقابل للأسماء الفارغة له أهمية سوى حفظ القيمة العددية للخانات وحسب ؟! هل المقصود هنا أن يحتوى الكشف على عدد 20 صف فحسب دون زيادة أو نقصان - على فكرة 20/ 20 = 1 مش 0 زي ما قلولنا فى الابتدائى - سامحنى على الاطالة - أحبكم فى الله -

اظهار و اخفاء المعادلات في كل الورقة :fff: اظهار و اخفاء المعادلات.rar