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

انظر للصورة واعمل مثلها ترتيب التسمية التوضيحية اجعلة عام او يمين او يسار حسب رغبتك ويمكن تحميل الايقونات من الموقع في الاسفل موقع ايقونات

اضف امر حفظ قبل الفتح TEST1 - Copy.accdb

اتفضل جرب كدة FMARK.rar

وعليكم السلام اتفضل استاذ فايز وبرجاء عدم تكرار الموضوع يكتفى بكلمه للرفع فى نفس الموضوع تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق FMARK.rar

مؤقت بسيط يجعل اكسل يحصي لك الثواني حتى رقم معين تحدده بنفسك ممكن استعماله عند طرح اسئلة معينه و الاجابة مطلوبة خلال فترة لا تتعدى هذا الرقم My_timer.xlsm

حل جميل استاذ @خالد سيسكو ومن باب اثراء الموضوع حل احر عن طريق دالة Switch =Switch([f_sex]=1;"ذكر";[f_sex]=2;"انثى") قائمة منسدلة31.accdb

السلام عليكم مشاركة مع الاستاذ @kha9009lid دالة بنفس الحفل تحياتي قائمة منسدلة.rar

طريقة اخرى عن طريق مربع تحرير وسرد قائمة منسدلة2.accdb

اليكم الفيديو الاول لشرح برنامج قوائم الفصول الهام للمدارس رابط الفيديو الاول لشرح البرنامج https://youtu.be/FnsLyBsMDcI رابط ملف البرنامج https://www.gulf-up.com/3zl9gniducti

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

اخى الفاضل اتفضل ان شاء الله يكون طلبك بعد اختيار name1 وجلب القيمه ل p2 يتم اعطاء القيمه ل حقل p1 المسمى price تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق TEST1.accdb

بارك الله فيك و شكرا على الشرح الجميل - تحياتى

السلام عليكم 🙂 عملت بعض الاضافات في مشاركتي السابقة ، وهذه هي الجزئية التي تتأكد ان الحقول مليانة : Private Sub cmd_Update_Click() If (Len(Forms!الرئيسية![44 form]![التسلسل] & "")) = 0 Then MsgBox "حقل التسلسل فارغ" Forms!الرئيسية.Form![44 form].SetFocus Forms!الرئيسية![44 form]![التسلسل].SetFocus Exit Sub ElseIf (Len(Forms!الرئيسية![44 form]![named] & "")) = 0 Then MsgBox "حقل الاسم فارغ" Forms!الرئيسية.Form![44 form].SetFocus Forms!الرئيسية![44 form]![named].SetFocus Exit Sub ElseIf (Len(Forms!الرئيسية![5 form]![تاريخ التولد] & "")) = 0 Then MsgBox "حقل تاريخ التولد فارغ" Forms!الرئيسية.Form![5 form].SetFocus Forms!الرئيسية![5 form]![تاريخ التولد].SetFocus Exit Sub ElseIf (Len(Forms!الرئيسية![8 form]![العمر] & "")) = 0 Then MsgBox "حقل العمر فارغ" Forms!الرئيسية.Form![8 form].SetFocus Forms!الرئيسية![8 form]![العمر].SetFocus Exit Sub ElseIf (Len(Forms!الرئيسية![form1]![المهنة] & "")) = 0 Then MsgBox "حقل المهنة فارغ" Forms!الرئيسية.Form![form1].SetFocus Forms!الرئيسية![form1]![المهنة].SetFocus Exit Sub ElseIf (Len(Forms!الرئيسية![form1]![رقم الموظف] & "")) = 0 Then MsgBox "حقل رقم الموظف فارغ" Forms!الرئيسية.Form![form1].SetFocus Forms!الرئيسية![form1]![رقم الموظف].SetFocus Exit Sub End If ShowBalloonTooltip "رجاء الانتظار ...", "تم تحديث معلومات :" & vbCrLf & "اسم الموظف ورقمه بنجاج", btWarning ' ShowBalloonTooltip "النتائج التي تم حفظها :", "التسلسل: " & Forms!الرئيسية![44 form]![التسلسل] & vbCrLf & _ "اللاسم: " & Forms!الرئيسية![44 form]![named] & vbCrLf & _ "المهنة: " & Forms!الرئيسية![form1]![المهنة] & vbCrLf & _ "رقم الموظف: " & Forms!الرئيسية![form1]![رقم الموظف], _ btWarning End Sub جعفر 1191.1.222.accdb.zip

الف رحمة على والديك استاذ @kha9009lid

هذا برنامج الاستاذ @محمد سلامة اتمنى تساعدني

كيف تبحث عن ملف pdf ، اعطني مثال ؟ وهل بيانات الحقل ImagePath دائما فاضية ؟ ولما تبحث عن ملف jpg ، كيف تبحث ، اريد مثال ؟ واريد صورة شاشة من احد المجلدات اللي فيها ملفات الـ pdf ، وصورة شاشة من احد المجلدات اللي فيها ملفات الـ jpg . جعفر

وعليكم السلام 🙂 الكود يحفظ ملفات jpg و pdf بنفس الطريقة : . والمسار يصير: مجلد قاعدة البيانات / comp1 / ثم E_ID هذه اختيارات comp1 : . وهذا نوع الحقل E_ID . في هذا الرابط انت سألت عن كيف عرض ملف pdf في النموذج : وبالاضافة الى تغيير الكائن في النموذج ، جواب الكود كان: web.Navigate Me![ImagePath] . بينما الكود عندك : Private Sub PicFile_AfterUpdate() On Error Resume Next Me![objIE].Object = Me![PicFile] '<----- End Sub . وقيمة الحقل PicFile . واللي اصلا غير عن: . وكذلك حقل ImagePath في الجدول فارغ !! . لذا ، وبإختصار شديد: شليله و ضايع راسها !! جعفر

اخى الفاضل عن اى ماكرو تتحث لم اذكر فى مشاركتى اى ماكرو للاطلاع على الكود اضغط alt+f11 انظر للفيديو واما عن المخالفه انت قمت بطرح اكثر من سؤال فى موضوع واحد وليس اكثر من موضوع فى موضوع واحد برجاء قم بتحميل 9 ملفات الموجوده بتوقيعى والاطلاع عليها ستفيدك وتتعلم منها الكثير باذن الله والدعاء لصاحبه الشرح بان يجازيها خيرا وانول مثلها من الدعاء ولجميع اخوانى واساتذتى جزاهم الله خيرا فالنهايه تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق Video_2020-03-20_121627.rar

شكرا جزيلا استاذي @kha9009lid احسنت ملاحظة اين صورتك القديمة للبروفايل كانت مميزة تحياتي

ممكن بدون الحاجة الى قائمة منسدلة فقط ضع مربع نص غير منظم قيمتة تساوي Choose([f_sex];"ذكر";"انثى")) واذا ترغب في اخفاء عبارة خطا عند السجل الجديد ضع =IIf(IsNull([f_sex]);"";Choose([f_sex];"ذكر";"انثى")) ملفك في المرفقات قائمة منسدلة.accdb

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

وعليكم السلام 🙂 يا ريت تعرض لنا الجواب هنا 🙂 القوائم اعلى النوافذ ، تتحكم في اظهارها / اخفائها بالامر الذي وضعته انت في مشاركتك الاولى ، بينما التحكم في الاطار اسفل النافذة (وهو طلبك) ، فالامر هو : إخفاء Application.SetOption "Show Status Bar", False إظهار Application.SetOption "Show Status Bar", True . ويمكن استعمال هذا الكود اول ما يعمل البرنامج ، فلا يظهر في البرنامج ككل ، واذا اردنا إظهاره في نموذج معين ، ثم اخفائه في بقية النماذج ، فنستعمل كود الاظهار عند فتح النموذج (او عند تنفيذ امر معين) ، ونخفيه عند اغلاق النموذج (او عند الانتهاء من الامر المطلوب) 🙂 جعفر

تم التعديل Option Explicit Sub SUPER_ADV_FILTER() 'كود الاستاذ سليم حاصبيا يقوم بترحيل الطلبة حسب رقم القيد ويفتح ورقة باسم رقم قيده Application.ScreenUpdating = False Dim i% Dim y$, m%, K%, RO%, lr Dim MY_Sht As Worksheet Dim WS As Worksheet: Set WS = Sheets("Main") Dim rg As Object Dim rg_to_copy As Range, Ful_rg As Range Set rg_to_copy = WS.Range("A10").CurrentRegion Set rg = CreateObject("System.Collections.Arraylist") lr = WS.Cells(Rows.Count, 1).End(3).Row With rg i = 11 Do Until i > lr If Not .contains(CLng(WS.Range("b" & i).Value)) _ And WS.Range("B" & i).Value <> "" Then _ .Add CLng(WS.Range("B" & i).Value) i = i + 1 Loop .Sort For i = 0 To .Count On Error Resume Next y = CStr(.Item(i)) If Len(Sheets(y).Name) = 0 Then Sheets.Add after:=Sheets(Sheets.Count) ActiveSheet.Name = y End If On Error GoTo 0 Next End With Set rg = Nothing For i = 2 To Sheets.Count Sheets(i).Cells.Clear Sheets(i).Range("T1") = "رقم القيد" Sheets(i).Range("T2") = Sheets(i).Name rg_to_copy.AdvancedFilter 2, Sheets(i).Range("T1:T2"), Sheets(i).Range("A3") Sheets(i).Range("T1:T2") = vbNullString Set Ful_rg = Sheets(i).Range("a3").CurrentRegion RO = Ful_rg.Rows.Count If RO > 1 Then Sheets(i).Range("a4").Resize(RO - 1).Formula = _ Evaluate("Row(1:" & RO - 1 & ")") Sheets(i).Columns("B:R").AutoFit End If Next '++++++++++++++++++++++++++++++++++++ Set MY_Sht = Nothing: Set WS = Nothing Set rg = Nothing: Set rg_to_copy = Nothing Set Ful_rg = Nothing '++++++++++++++++++++++++++++++ Application.ScreenUpdating = True End Sub الملف من جديد My_tarhil.xlsm

وتحيا مصر ام الدنيا مع تأييدي المطلق لهذه الكلمة أقول أنا لبناني "تحيا الثورة" وربنا يحفظ بلد الأرز الخالد و كلّنا للوطن

تم التعديل كما تريد Option Explicit Sub Create_Sheet_WITH_HYPER() Rem =======>> CREATED BY SALIM HASBAYA ON 20/3/2020 Dim Tg As Worksheet Dim i%, My_name$ Dim RGA As Range, Var_Rg As Range Dim Final_Rg As Range, Ro% Application.ScreenUpdating = False Set RGA = Salim.Range("C8").CurrentRegion.Columns(1) If Salim.AutoFilterMode Then Salim.Range("c8").CurrentRegion.AutoFilter End If Application.DisplayAlerts = False For Each Tg In Sheets If Tg.Name <> "Salim" Then Tg.Delete Next Tg Application.DisplayAlerts = True For i = 4 To 6 'تستطيع ان تغير الرقم 7 الى اي رقم اقل من 72 (عدد الأعمدة+4) Set Var_Rg = Salim.Cells(8, i).CurrentRegion.Columns(i - 2) Var_Rg.AutoFilter 1, Criteria1:="<>" If Len(Salim.Cells(8, i)) > 30 Then My_name = Left(Salim.Cells(8, i), 30) Else My_name = Salim.Cells(8, i) End If Sheets.Add(after:=Sheets(Sheets.Count)).Name = My_name With ActiveSheet RGA.SpecialCells(12).Copy .Range("B2") Var_Rg.SpecialCells(12).Copy .Range("C2") .Range("B:C").Columns.AutoFit .Hyperlinks.Add Anchor:=.Range("E2"), Address:="", SubAddress:= _ "Salim!A9", TextToDisplay:="Goto SALIM" End With Set Final_Rg = ActiveSheet.Range("B2").CurrentRegion Ro = Final_Rg.Rows.Count If Ro > 1 Then With ActiveSheet .Range("A2") = "N#" .Range("A" & Ro + 2).Offset(, 1) = "Sum" .Range("A3").Resize(Ro - 1) = Evaluate("Row(1:" & Ro & ")") .Range("A" & Ro + 2).Offset(, 2).Formula = "=SUM(C3:C" & Ro + 1 & ")" .Range("A" & Ro + 2).Offset(, 2).Value = _ .Range("A" & Ro + 2).Offset(, 2).Value .Range("B2:b3").Copy .Range("A2").Resize(Ro).PasteSpecial Paste:=xlPasteFormats .Range("A" & Ro + 2).Resize(, 3).PasteSpecial Paste:=xlPasteFormats End With Application.CutCopyMode = False End If Salim.Range("C8").CurrentRegion.AutoFilter '============================ Next Salim.Select Application.ScreenUpdating = True End Sub الملف مرفق من جديد My_NEW_filter.xlsm

اليكم البرنامج مرة اخرى بعد عمل تعديل عليه والغاء الحماية عن صفحة الاسماء قوائم_الفصول_بعد_التعديل.rar

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

جرب هذا الكود Option Explicit Sub find_Over_Three() Dim R%, i% With Range("Bq5").Resize(187, 2) .ClearContents .Interior.ColorIndex = xlNone End With R = Cells(Rows.Count, 1).End(3).Row With Range("Bq5").Resize(R - 4) .Formula = "=COUNTIF(B5:BP5,""شخصى"")" .Value = .Value End With For i = 5 To R If Cells(i, "Bq") > 3 Then Cells(i, "Bq").Interior.ColorIndex = 6 End If Next End Sub الملف مرفق April.xlsm

طريقة العمل: . 1. من برنامجك ، تستورد الوحدتين النمطية ، BalloonTooltip و basBalloonTooltip ، من البرنامج BalloonToolTipSample.mdb ، واذا اردت ان تعمل نسخ ولصق للوحدتين النمطية ، تأكد بأنك تلصق كل وحدة نمطية في مكانها الصحيح : basBalloonTooltip في Module BalloonTooltip في Class Module 2. تشغل برنامج اللي في رابط مشاركتي اعلاه : BalloonToolTipSample.mdb ، ثم تضع النص اللي تريده ، 3. اختار احد الاختيارات ، 4. جربه ، وشوف نتيجته ، 5. ولما تختار من رقم 3 ، انقر على الرقم 5 حتى يعطينا البرنامج الكود الذي نستعمله ، 6. ننسخ الكود في الذاكرة ، ثم نلصقه في برنامجنا : Private Sub cmd_Update_Click() ShowBalloonTooltip "رجاء الانتظار ...", "تم تحديث معلومات :" & vbCrLf & "اسم الموظف ورقمه بنجاج", btWarning End Sub . . وانواع الايقونات هي : btNone btInformation btWarning btCritical . ونستطيع التوسع ، وجعل بيانات معينة تظهر ، مثل: . والذي عملناه بهذا الكود : ShowBalloonTooltip "النتائج التي تم حفظها :", "التسلسل: " & Forms!الرئيسية![44 form]![التسلسل] & vbCrLf & _ "اللاسم: " & Forms!الرئيسية![44 form]![named] & vbCrLf & _ "المهنة: " & Forms!الرئيسية![form1]![المهنة] & vbCrLf & _ "رقم الموظف: " & Forms!الرئيسية![form1]![رقم الموظف], _ btWarning . وهناك كمية معينة من البيانات التي ممكن اظهارها ، وإلا ، فلن يظهر إلا الكم المسموح به فقط 🙂 . الى هنا وينتهي العمل . ---------------------------------------------------------------- اذا عملنا ايقونه خاصه لبرنامجنا ، انا عملت حرف J باللون الازرق : . ومن اعدادات البرنامج ، نختار صورة الايقونه للبرنامج : . فنلاحظ انه تظهر في اعلى يسار الشاشة : . وكذلك ستظهر الايقونه مع الرسالة : . جعفر 1191.222.zip

وهذا هو الملف الخاص بقوائم الفصول نسخة_من_قوائم_الفصول_الاصدار_8.rar

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