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

وجدت هذا الملف منشور على النت يبدو لي من النظرة المبدئية أن الملف سهل ممتنع ، يقوم بحساب و رسم الشبكة بطريقة المسار الحرج بناء على التقدير ثلاثي النطاق و يمكن عدم تطبيق التقدير ثلاثي النقاط بوضح الزمن مباشرة فى عمود زمن النشاط (L) بدلا من المعادلة التي تحسبه يناء على التقدير المتشاءم و المتفائل و الاكثر توقعها critical-path-method.xlsx المصدر

بعد اذن استاذ أحمد زمان طبعاً ...يمكنك استخدام هذا الكود فى حدث الصفحة لتكبير حجم الخط فى القائمة المنسدلة وأعتقد ان هذا يكفى فى هذه المشاركة فيجب الغلق فمن الطبيعى والمفترض ان تكون المشاركة لطلب واحد بارك الله فيكم Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error GoTo Skipper Dim x As Long x = 100 If Target.Validation.Type = xlValidateList Then x = 130 Skipper: ActiveWindow.Zoom = x End Sub _البرنامج 1-7-2020 - نسخة (2) (1).xls

وعليكم السلام- استبدل معادلتك الشرطية بهذه المعادلة =IF(AND($C6<>"",$C6<>0),CHOOSE($C6,"-","-","15","45","85","125","165"),"") أما بالنسبة للصفحة التى لا تحتوى على هذه المعادلة الشرطية (P 41 - Monolo) فيمكنك جعل تنسيق الخلايا بها كما بالصورة ... وشكراً 1 Drivers Over Time Summary1.xlsx

تفضل Private Sub zer1_Click() Dim ctl As CommandButton Set ctl = Me!zer1 With ctl .HyperlinkAddress = "https://www.google.com/maps/place/" & Me.comloc .Hyperlink.Follow End With End Sub db1.mdb

تمام التمام نعم هو المطلوب بارك الله فيك اشكرك ولك خالص تحياتى

تستاهل استاذ صالح الف مبروك

تفضل يا دكتور حلبي إن شاء الله يكون المطلوب ممكن التحكم في السرعة من مربع النص Call him(Me, Speed) الوحدة النمطية Public Function him(FRM As Form, x As Integer) On Error Resume Next FRM.BRBar.Visible = True Dim z As Integer DoCmd.SetWarnings False FRM.BRBar.Max = x For z = z To x FRM.BRBar.Value = z Next z FRM.BRBar.Visible = False End Function تول بار.accdb

تفضل دكتور حلبي : في الوحدة النمطية : Public Function him(FRM As Form) Dim z As Integer DoCmd.SetWarnings False For z = z To 900 FRM.BRBar.Value = z Next z End Function ننادي عليه من أي مكان في النماذج هكذا Call him(Me) تول بار.accdb

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

ممكن انسى انى ادخلت رقم واضعه مرة اخرى فيتم الجمع لا يمكن ان يحصل هذا الامر الا اذا كان مفصوداً لان الخلابا في العامودين (K,L) تتلون فور ادراج أرقام فيها لذلك قبل ادخال اي رقم تتأكدي ان لون الحلايا المقابلة للاسم في العامودين (K,L) غير ملوّنه واخيراً لنفرض انه بالخطأ تم ادخال رقم 100 الى الاسم رقم 1 عندها تقومين بادخال ناقص 100 (100-) وتحل المشكلة على كل حال تم اضافة شيء ما الى الكود ليقوم بالتنبيه 1-قي حال قمتي باضاقة اي رقم مرة اخرى (لنفس الاسم) تخرج لك رسالة بهذا الامر مع الزر الافتراضي No اذا اردتي الابقاء على كل شيئ كما كان (الاضاقة لمرة واحدة فقط) اضغطي No او Enter واذا ارني الاضافة مرة ثلنية على نفس الاسم Yes الملف من جديد Msgbox_YARA_2User_With_Info..xlsm

مبارك استاذ صالح أبو آمنة وبالتوفيق وجزاك الله خيرا

1.xlsx المسالة بسيطة بالتنسيق الشرطي واستخدام دالة =Today()

شكراً لك ابو البشر اطمئن تم دمج المشاركتين في مشاركة واحدة ، وتم تعديل الموضوع ليشمل المشاركتين .

تم تضييق الهامشين (الأعلى والأسقل) قليلاً واصيح بالامكان العمل مع 16 اسم في كل ورقة مما يوفر كمية لا باس بها من الورف (بالنسبة لـــ 40 الف اسم) حوالي 350 ورقة Ahlawi_New_16.xlsm

تفضل ..... ولكن عنوان الموضوع يجب ان يكون موافق لما في داخل الموضوع ( قوانين المنتدى ) ... بارك الله فيك استخلاص تاريخ الميلاد.rar

للأسف فد جربت ما تريده لكن لم استطع ان أحصل على اكثر من 14 اسم على ورقة واحدة (لأن البيانات تخرج منقسمة) Ahlawi_New_14.xlsm

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

تفضل المثال MyData.accdb

واياك .... حياك الله

بالخدمة استاذ هناك كلمات لا يجوز استخدامها كمسميات لجداول او حقول او نماذج او عناصر وغيرها لانها ستبب مشكلة مستقبلا خصوصا عند استخدامها في الاكواد راجع الموضوع ادناه https://www.officena.net/ib/topic/39164-الكلمات-والرموز-المحجوزة-في-أكسس-بحث-تطبيق/

طبعاً بعد اذن استاذنا الكبير سليم ... اخى الكريم bander22122 , الهدف الأساسى من المنتدى هو محاولة التعلم وليس اخذ المعلومة على الجاهز بدون الإستفادة والتعلم حتى يأتى لك يوم تفيد من يحتاج الى مساعدتك كما تم تقديم المساعدات لك من قبل اساتذتنا الكبار الأمر ليس صعب بل هم بسيط للغاية ويمكنك عمل ذلك بنفسك وكما أخبرك استاذنا الكريم سليم فقط عليك تغيير الرقم 100 الى اى رقم تريد فليكن 900 وبعد التعديل فى كل مواضع المعادلة .. عليك العلم بأن هذه ليست معادلة عادية بل هى معادلة مصفوفة .. اى بعد الإنتهاء من تغيير كل رقم 100 الى الرقم الذى تريده عليك بالضعط على ( Ctrl+Shift+Enter ) فلابد من ظهور الأقواس بهذه الطريقة بالمعادلة بعد هذه الخطوة {} وليس Enter فقط كباقى المعادلات وهذا هو السبب فى انك لم تستطع ضبط المعادلة ... وشكرا واسفغ على الإطالة

مبارك للمنتدي أبا آمنة. وجزاكم الله عنا خيرا

السلام عليكم و رحمة الله وبركاته اخي الفاضل تم عمل الكود في حدث التغيير في الورقة لذلك فقط بمجرد كتابة رقم القائمة في الخلية الصفراء تظهر النتائج فورا Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$I$3" Then Q1 = Range(Target.Address).Value Range("B15:J39").ClearContents TR = 15 With Sheets("ÊÝÇÕíá ÇáãÈíÚÇÊ") For FR = 4 To 999 If .Cells(FR, 2) = Q1 Then Cells(8, 4) = .Cells(FR, 3) Cells(TR, 2) = .Cells(FR, 1) Cells(TR, 3) = .Cells(FR, 4) Cells(TR, 4) = .Cells(FR, 5) Cells(TR, 5) = .Cells(FR, 6) Cells(TR, 7) = .Cells(FR, 8) Cells(TR, 8) = .Cells(FR, 9) Cells(TR, 9) = .Cells(FR, 10) Cells(TR, 10) = .Cells(FR, 11) Cells(12, 9) = .Cells(FR, 12) Cells(10, 9) = .Cells(FR, 14) Cells(10, 4) = .Cells(FR, 15) Cells(12, 4) = .Cells(FR, 16) TR = TR + 1 End If Next FR End With Range(Target.Address).Select End If End Sub مرفق الملف ahmed1.xlsm

الف مبروك استاذ صالح وموفق ان شاء الله

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

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

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

تفضل يمكنك جعل المعادلة هكذا ... وتم عمل أيضاً تنسيق شرطى للخلية اذا كان بها كلمة مغادرة =IF(G$7=$D8,"مغادرة",IF(AND(G$7>=$C8,G$7<=$D8-1),$E8,0)) If Function.xlsx

كان عليك استخدام خاصية البحث بالمنتدى -تفضل دالة جميلة للترجمة من الانجليزية الى لغات العالم

جرب هكذا وهناك ايضا فيديو لشرح عملية التحويل للأستاذة ساجدة العزاوى لها منا كل الإحترام ج100 كيف نجعل كود 32 بت يعمل على 64 بت وعدم ظهور خطأ ptrsafe اكسل vba ساجدة العزاوي تحويل64بيت.xlsb

أحسنت استاذ محمد بارك الله فيك

تفضل با صديقي AB_Shraf.xlsm

أعمال ممتازة استاذ أحمد جزاك الله كل خير

بارك الله فيك وزادك الله من فضله

جرب هذا Book1.xlsm

من فضلك اخى الكريم لا تبخل بنجاح المشاركة فليس هناك وجود لأى مشاركة الا بعد تدعيمها بملف مشروح فيه كل المطلوب بكل دقة والا فكان عليك لزاماً استخدام خاصية البحث بالمنتدى قبل رفع هذه المشاركة طالما انك لم تقم برفع ملف !!! ولا تقول ان المشاركة بسيطة لا تحتاج لكل هذا ... فان كان طلبك بسيط لأستطعت انت بنفسك حله ولا احتجت لمساعدة الأخرين فى حل مشكلتك وتفريج كربتك تفضل هذا الكود Sub Unhide_All_Sheets() Dim ws As Worksheet ActiveWorkbook.Unprotect For Each ws In Worksheets ws.Visible = xlSheetVisible Next End Sub وهذا كود أخر Sub Unhide_All_Sheets_Count() Dim wks As Worksheet Dim count As Integer count = 0 For Each wks In ActiveWorkbook.Worksheets If wks.Visible <> xlSheetVisible Then wks.Visible = xlSheetVisible count = count + 1 End If Next wks If count > 0 Then MsgBox count & " worksheets have been unhidden.", vbOKOnly, "Unhiding worksheets" Else MsgBox "No hidden worksheets have been found.", vbOKOnly, "Unhiding worksheets" End If End Sub وهذا كود ثالث Sub Unhide_Selected_Sheets() Dim wks As Worksheet Dim MsgResult As VbMsgBoxResult For Each wks In ActiveWorkbook.Worksheets If wks.Visible = xlSheetHidden Then MsgResult = MsgBox("Unhide sheet " & wks.Name & "?", vbYesNo, "Unhiding worksheets") If MsgResult = vbYes Then wks.Visible = xlSheetVisible End If Next End Sub وهذا كود رابع Sub Unhide_Sheets_Contain() Dim wks As Worksheet Dim count As Integer count = 0 For Each wks In ActiveWorkbook.Worksheets If (wks.Visible <> xlSheetVisible) And (InStr(wks.Name, "report") > 0) Then wks.Visible = xlSheetVisible count = count + 1 End If Next wks If count > 0 Then MsgBox count & " worksheets have been unhidden.", vbOKOnly, "Unhiding worksheets" Else MsgBox "No hidden worksheets with the specified name have been found.", vbOKOnly, "Unhiding worksheets" End If End Sub اختر منهم ما يناسبك عرفت ان كده اهدار للوقت لأنك لم تقم من البداية برفع الملف فالخطأ عندك ,فالملف لم تقم بوضع اى كود به-تفضل بعد وضع الكود يعمل بكل كفاءة مثال.xlsm