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

وعليكم السلام 🙂 نفترض ان حقل اليوم هو iDate ، وحقل العطلة هو iLeave ، عليه ، ممكن نضع هذا الكود على حدث "بعد تحديث" iDate : select case me.iDate case "Friday" , "Saturday" , "الجمعة" , "الجمعه" , "السبت" me.iLeave ="عطله رسمية" else case me.iLeave ="" end select . اما اذا اردت ان تجعلها في استعلام ، فيمكن استعمال الكود التالي للحقل iLeave : iLeave: iif([iDate]="Friday" or [iDate]="Saturday" or [iDate]="الجمعة" or [iDate]= "الجمعه" or [iDate]="السبت" ,"عطلة رسمية" , "") جعفر

وذلك بوضح هذه الأكواد بحدذ الصفحة Public oldval As Double Sub KH_TEST() oldval = 0 End Sub Private Sub Worksheet_Change(ByVal Target As Range) If [x1] = False Then GoTo 1 If Not Intersect(Target, Range("C3:m101")) Is Nothing Then Application.EnableEvents = False If IsNumeric(Target) Then _ Target = oldval + Target Else Target = oldval Application.EnableEvents = True End If 1 End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If [x1] = False Then GoTo 1 If Not Intersect(Target, Range("C3:m101")) Is Nothing Then Application.EnableEvents = False If IsNumeric(Target) Then oldval = Target Else oldval = 0 Application.EnableEvents = True End If 1 End Sub الصلاة١.xlsm

بالخدمة اخي العزيز Root4510.rar

السلام عليكم استاذ حربي العنزي هذه محاولة ارجو ان تكون موفقة يرجى التاكد من النتائج قبل الاستخدام النهائي ملاحظة : دالة العدد الصحيح هي دالة لاحد الاساتذة وعذرا لاني لا اعلم من هو ام دالة الكسر فهي محاولة وهي ايضا مبنية على دالة العدد الصحيح مع بعض التعديلات Root4500.rar

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

رمضان كريم الاستاذان عبدالفتاح في بي اكسيل و الرائد 77 الف مبروك الترقية التي تستحقانها عن جدارة

بعد اذن استاد علي كود بطريقة اخرى انقر على اي قيمة من الخلايا المحددة سيطلع مربع حوار اكتب القيمة وسيتم الاضافة Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim xRtn As Variant If Selection.Count = 1 Then If Not Intersect(Target, Range("c:m")) Is Nothing Then If IsNumeric(Target) And Target <> "" Then xRtn = Application.InputBox("Insert your value please") If xRtn <> False And IsNumeric(xRtn) Then Target.Value = Target + xRtn End If End If End If End If End Sub الصلاة2.xlsm

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

تفضل اخي العزيز ارجو ان يكون طلبك في النموذج الثاني فيه طلبك الثاني Root100.rar

تفضل اخي العزيز Rep2: IIf([Type] = 1;"عربي";IIf([Type] = 2;"انجليزي";"فرنسي")) ارجو ان يكون طلبك ملاحظة : اسم الحقل Type من الكلمات المحجوزة وعليه يجب تبديل الاسم

السلام عليكم 🙂 الكود باللون الاصفر يعمل تغيير معين في ريجستري الكمبيوتر (لا اعرف هذا التغيير) ، ولا علاقة له بالنسخ 🙂 جعفر

طريقة اخرى مع طرق المبدع @jjafferr ممكن تضع مصدر مربع النص هذا الكود .... على افتراض ان مربع النص الذي يظهر فيه عبارة الخميس والجمعة هو a =IIf([a]="الخميس" Or [a]="الجمعة";"عطلة رسمية")

السلام عليكم 🙂 اعتقد اخوي @ابوخليل عنده معرفة في هذا الموضوع اكثر مني 🙂 جعفر

شكرا لك إستاذي العزيز علي وإن شاء الله في ميزان حسناتك مشكور استاذي عبد الفتاح وإن شاء الله في ميزان حسناتك

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

وعليكم السلام اتفضل ان شاء الله يكون ما طلبت Database2(1).accdb

اتمنى ان يكون ما تريد في هذا العمل stok.xlsm

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

وعليكم السلام اخى @beLaL 100 جرب ووافنى بالنتيجه ان شاء الله يكون ما تريد تم تغيير الرقم 4 الى 6 وجزاها الله خيرا ام عهود DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 6) ' Next line shows the required path for the backup database NewFile = "e:\العملاء" & "\" & DBwithoutEXT & " Backup Date " & Format(Date, "yyyy_mm_dd") & " Time " & Format(Now(), "Hh Nn AMPM") & Right(DBwithEXT, 6) بالتوفيق اخى قاعدة بيانات.rar

تفضل اخي الكريم مع انني ضد فكرة حذف الملفات تلقائيا والسبب في بعض الاحيان تحتاج الى الرجوع لملف قديم للاطلاع على تعديل ما ملاحظة هامة جدا :: الكود يحذف كل الملفات في المجلد D:\Backup نسخة احتياطية مضغوطة.rar

اليكم فيديو شرح برنامج احفظ جدول الضرب https://youtu.be/GaMychEZxmU وملف البرنامج اسفل الفيديو ملف البرنامج محدث فى الاسفل الرابط

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

كلمات الشكر قليلة جداً مع انسان رائع مثلك

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

جميل 🙂 انت استبدلت مكان الحقلين في الاستعلام ، بحيث وضعت الحقل "التسلسل داخل" الذي فيه القيم كاملة اولا ، ثم الحقل "التسلسل خارج" الذي القيم فيه غير كامله ثانيا : . ولكنك لم تنتبه الى ما قاله صاحب الموضوع : فجوابك يصلح للسيناريو الموجود حاليا ، ولكن لما يصير العكس ، فطريقتك لن تعمل 🙂 جعفر

نسال الله ان ينفعنا بعلمكم و ان نفيد الاخرين

وهذه طريقه أخرى .... Rep2: Choose(([Type]);"عربي";"انجليزي";"فرنسي")

وعلى جميع الناس اللهم امين

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

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

اخي حسام 🙂 ليش الاعتذار ، هي تجربة انت قمت نها !! جعفر

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

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

يا اخي لست بحاجة الى اكثر من 6000 صف لمعاينة عمل ماكرو الماكرو الذي ينفذ على صف واحد يمكن ان يعمل على الوف الصفوف تم ادراج ملف يحتوي على بضغة بيانات للتجربة واليك النتيجة الكود Option Explicit Sub SansDoublons_By_FirstAcurance() If ActiveSheet.Name <> "Sheet1" Then Exit Sub Dim d As Object Dim Lr_c#, i#, k#, a(), b() Dim x x = [G4].CurrentRegion.Rows.Count If x > 6 Then _ [G4].CurrentRegion.Offset(6).Resize(x - 6).Clear Lr_c = Cells(Rows.Count, "c").End(3).Row If Lr_c < 10 Then Exit Sub Set d = CreateObject("Scripting.Dictionary") a = Range("C10:D" & Lr_c) ReDim b(1 To UBound(a, 1)) For i = LBound(a) To UBound(a) If a(i, 1) <> vbNullString Then For k = 1 To UBound(a, 2): b(k) = a(i, k): Next d.Item(a(i, 1)) = b End If Next i With [G10].Resize(d.Count, UBound(a, 2)) .Value = Application.Transpose(Application.Transpose(d.items)) .Borders.LineStyle = 1 .InsertIndent 1 End With End Sub الملف مرفق Without_Duplicate.xlsm

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

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

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله خيرا بالتوفيق اخى

السلام عليكم 🙂 اذا لاحظت المثال الذي ارفقته انا ، فعملت مجلد داخل مجلد ، مثل D:\Testing\Data_Folder ، لهذا السبب هناك كود لكل مجلد : dim myFolder as string عمل المجلد الاول' Testing myFolder= "D:\Testing" if len(dir(myFolder, vbDirectory))=0 then mkdir myFolder end if عمل المجلد التالي' Data_Folder myFolder= myFolder & "\Data_Folder" if len(dir(myFolder, vbDirectory))=0 then mkdir myFolder end if لذلك ، يجب عليك عمل المجلد الخارجي اولا Testing (او على الاقل التأكد انه موجود ، و الكود اذا لم يجد المجلد ، فإنه يعمله) ، وبعدها تعمل المجلد الذي بداخله Data_Folder (وكذلك الكود اذا لم يجد المجلد ، فإنه يعمله) 🙂 بالنسبة الى لمجلدات التي اردتها انت ، فيمكن عملها كما قال اخي حسام ، هكذا : Private Sub btn17_Click() Dim str_folder As String str_folder = CurrentProject.Path & "\fails" If Len(Dir(str_folder, vbDirectory)) = 0 Then MkDir (str_folder) End If str_folder = str_folder & "\" & Format(Me.num, "0000000") ' folder to open If Len(Dir(str_folder, vbDirectory)) = 0 Then MkDir (str_folder) End If Call Shell("explorer.exe " & str_folder, vbNormalFocus) End Sub جعفر

جزاك الله خيرا اخى @kanory

تفضل انظر الطريقة .......... moh.accdb

ممكن عملها بطريقة أخرى .... وهي أن المربع الاختيار يكون موجود للجميع ... لكن عند اختيار وظيفة معينة يتم وضع علامة صح امام جميع من يمثل تلك الوظيفة ....

منور اخى واستاذى @essam rabea ان شاء الله تكون بخير انت والاهل واهل اسكندريه كلهم جزاك الله كل خير

جزاك الله خيرا اخى @عذاب الزمان ع مشاركتك ايانا الحل وجزاه الله خيرا اخى @ابو تراب بارك الله فيكم بالتوفيق اخوانى

يمكنك ذلك بملاحظة ودراسة معادلات جدول البيانات الأخر المتواجد من النطاق CC1: CH3 حيث تم تعديل معادلة الرسم البيانى لأن يأخذ من هذا الجدول ..وموجود كل هذا بالملف المرسل اليك

إضافة زر استعراض بدل نسخ مسار المجلد الذي يحتوي على الملفات في inputbox hyperlink2.xlsm

تفضل اخي اتبع ما موجود في الصور ثم ضع هذا الكود تاكد من مسار الصورة حتى لايحدث خطا معك في الكود Private Sub UserForm_Initialize() Me.WebBrowser1.Navigate2 "C:\Download\1.gif" End Sub

وعليكم السلام-تفضل كشف رصد درجات المرحلة الأساسية.xlsb

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

السلام عليكم جرب المرفق و لا ادري ان كانت هناك اخطاء او لا الصادر و الوارد_.rar