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

والان حتى تكتمل الفائدة المرفق النهائى يحتوى على جميع الافكار Tab05 (1).accdb

مشاركة مع استاذي العزيز ابا جودى كود جميل جدا عاشت ايدك استاذ ابا جودى بالنسبة لطلبك استاذ nssj تفضل هذا الكود Call SpDelRec(Me.RecordSource, "TNO") الكود اعلاه يعمل اذا كنت مختار مصدر بيانات نفس الجدول اي ليس على شكل استعلام وفيه شروط لان الاستعلام يحتاج الى كود لاستخراج اسم الجدول

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

السلام عليكم ورحمة الله وبركاته أتمني من الله العلي القدير أن تكونوا في أتم الصحة والعافية وبجهود الأخوة الأكارم في هذا المنتدى المبارك انتهيت اليوم من عمل ملف لحفظ وتثبيت القرآن الكريم أسأل الله تعالى أن يكتب الأجر للجميع وهو الآن تحت تصرف الإخوة في المنتدي لنشر الخير وكذلك إبداء الملاحظات والأفكار إن وجدت للأسف حاولت رفع الملف ورفض الموقع لأن حجمه أكثر من 1000كيلو بايت وهذا للتعليمات والأخر هو الملف .... تــــم رفع الملفات داخل المنتدى , لإكتمال الإستفادة تعليمات-برنامج.pdf 1270891612_----.xlsm

السلام عليكم مشاركة مع استاذى الجليل واخى الحبيب @husamwahab ضع الكود الاتى فى موديول Function SpDelRec(ByVal strTableName As String, ByVal strFieldName As String) On Error GoTo ErrorHandler Const MyMsg = "Are you sure you wish to delete the records?" If MsgBox(MyMsg, vbYesNo + vbQuestion, "Confirm") = vbYes Then DoCmd.SetWarnings False DoCmd.RunSQL "DELETE [" & strTableName & "].* FROM [" & strTableName & "] WHERE ((([" & strTableName & "].[" & strFieldName & "]) Between [start delete from] And [To]))" DoCmd.SetWarnings True Else Exit Function End If ExitHere: On Error GoTo 0 Exit Function ErrorHandler: Select Case Err.Number Case Is = 2001, 3167 MsgBox "Action Aborted . " Case Else MsgBox Err.Description, , "ERROR " & Err.Number GoTo ExitHere End Select End Function وقم بعمل زر امر فى النموذج الذى تريد وضع الكود الاتى فى حدث عند النفر على الزر 'Call SpDelRec("Table Name", "Field Name") Call SpDelRec("TAB_RMZ", "TNO") وطبعا لأنك طلبت تم كتابة الروتين ليكون عام ومرن ليجعلك تكتب اسم الجدول الذى تريده مهما كان عدد الجدول فى كل زر امر اكتب الجدول الذى تختصه فى حذف السجلات منه وكذلك اسم الحقل جعلته مرنا تكتبه بكود زر الامر حتى ان كان اسماء الحقول مختلفة فى الجداول طبعا لا انسى أخص بالشكر استاذى الجليل ومعلمى القدير الأستاذ @jjafferr من أجل هذة الجزئية تحديدا [" & strTableName & "] جزاه الله هو وكل اساذتى الكرم كل الخيـر تقبل تحياتى

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

هل تريدها هكذا

لا تقول لحالك شئ تانى ولا تكلمه دى اخرتها هاهاهاهاهاها

شكراَ للأخ ناقل والأخ الناقل ابا جودى 😁 تم المطلوب بحمد الله .. فبارك الله فيكما مع إني زعلان شوي .. فكرت حالي صرت معلم، وخليت النماذج الفرعية بخاصية غير مرئي، وبالنسبة للسطر If Not IsNull(Form_FRM_TFX.txtMNO) Then Me.FRM_TFX.Visible = True Else Me.FRM_TFX.Visible = False شفتو طويل شوي .. وقلت لحالي: مادام إنو هالنموذج صار غير مرئي أصلا، يعني مافي داعي للجملة الأخيرة (Else Me.FRM_TFX.Visible = False) وشطبتها .. بس ما زبطت .. صار النموذج يظهر حتى وحقل (MNO) فارغ .. والغريب إنو بيظهر دايما مع نموذج (Frm_TF) فرجعت كل شي زي ماكان .. وبطلت تجارب واختراعات 😐

مع إني مش فاهم إشي من الكود 🙄 .. بس برضو أنا إلي دور في الموضوع .. بسبب السطر السحري إللي أضفتو Me.Requery 😂 😂 😂

وعليكم السلام 🙂 اخذت نسخة من النموذج اليومي ، وابدلته من نموذج مستمر الى نموذج فردي ، ثم عملت استعلام ينادي وحدة نمطية لأخذ البيانات من الجدول tblAppointments 🙂 وعملت تعديل للمكتبات لتعمل على النواتين 32بت و64بت 🙂 جعفر 1367.NA_Calendar.mdb.zip

شكلو مصباح علاء الدين شغال اليوم على وذنو 😁 .. وأنا مش ملحق عليه .. راح أجرب المرفق وأبلغكم بالنتيجة

ونقلا عن الاستاذ @ناقل اتفضل المرفق MusndWZwayid001(2).accdb

هذا الكود مبدئياُ من أجل القوائم المنسدلة (المترابطة) اذا لم تظهر القائمة الرئيسية في النطاق من B7 الى B31 من الصفحة (FATURA) غادر الضفجة ثم عد اليها من جديد Option Explicit Dim D As Worksheet, S As Worksheet Dim F As Worksheet Dim LrD%, LrS%, lrF% '+++++++++++++++++++++++++++++++++ Private Sub Worksheet_Activate() data_val End Sub '++++++++++++++++++++++++++++++++++++ Private Sub Worksheet_Change(ByVal Target As Range) Dim K%, t%, F_rg As Range Dim sec_arr(), mm%, y% Dim BoL As Boolean Dim Dt As Worksheet Set Dt = Sheets("DATA") Application.EnableEvents = False If Not Intersect(Target, Range("B7:B31")) Is Nothing And _ Target.Count = 1 Then If Target <> "" Then Set F_rg = Dt.Range("D1:K1").Find(Target, lookat:=1) If F_rg Is Nothing Then GoTo Fin BoL = True t = F_rg.Column mm = 2 Do Until Dt.Cells(mm, t) = "" ReDim Preserve sec_arr(1 To mm - 1) sec_arr(mm - 1) = Dt.Cells(mm, t) mm = mm + 1 Loop End If If BoL And mm > 2 Then With Target.Offset(, 1).Validation .Delete .Add 3, Formula1:=Join(sec_arr, ",") End With y = Application.RandBetween(1, mm - 2) Target.Offset(, 1) = sec_arr(y) End If End If Fin: Application.EnableEvents = True End Sub '+++++++++++++++++++++++++++++++++++++ Sub Begin() Set D = Sheets("Data") Set S = Sheets("SALES") Set F = Sheets("FATURA") LrS = S.Cells(Rows.Count, 1).End(3).Row lrF = F.Cells(Rows.Count, 2).End(3).Row End Sub '++++++++++++++++++++++++++++++++++++++++ Sub data_val() Begin Dim ro%, i%, arr() ro = D.Cells(Rows.Count, 1).End(3).Row ReDim arr(1 To ro - 1) i = 2 Do Until i = ro + 1 arr(i - 1) = D.Cells(i, 1) i = i + 1 Loop With F.Range("B7").Resize(25).Validation .Delete .Add 3, Formula1:=Join(arr, ",") End With End Sub الملف مرفق My_Bok.xlsm

السلام عليكم ورحمة الله تعالى وبركاته استاذى الجليل ومعلمى القدير @husamwahab ولان الاستاذى الفاضل الكريم @nssj طلب كود ذكى هاهاهاهاها عجباني قوى كود ذكى دى وحضرتك تفضلت علينا جميعا بحلولك الرائعة وأكوادك الأروع أرد بضاعتكم اليكم بإعادة التكويد ليكون روتين عام داخل موديول ليسهل التعامل معه فى زوايا البرنامج سواء كان مصدر البيانات استعلام او جدول الكود داخل الموديول Public Function RcrdSrc(ByVal RecordSource As String) On Error GoTo ErrorHandler Dim FirstChar As Long Dim SecondChar As Long Dim XCount As Long RecordSource = Replace(RecordSource, ";", " ") FirstChar = InStr(RecordSource, "from") + 5 SecondChar = InStr(FirstChar, RecordSource, " ") XCount = SecondChar - FirstChar RcrdSrc = Mid(RecordSource, FirstChar, XCount) ExitHere: On Error GoTo 0 Exit Function ErrorHandler: Select Case Err.Number Case Is = 5 RcrdSrc = (RecordSource) Case Else MsgBox Err.Description, , "ERROR " & Err.Number GoTo ExitHere End Select End Function ولجلب مصدر البيانات يتم استخدام الكود الاتى MsgBox (RcrdSrc(RecordSource)) طبعا انا استخدمت فى الشرح صندوق رسائل كل واحد يضع الكود أينما يريد بدلا من صندوق الرسائل المستخدم فى للشرح هنا فقط DB(2).mdb

استخدم هذا الكود للشق الاول من السؤال لاني اكتب من الجوال ضع هذا الكود في النموذج الرئيسي ... Private Sub Form_Current() Me.FRM_RMZ_X.Visible = Me.FRM_RMZ_X.Form.Recordset.RecordCount > 0 Me.Frm_TF.Visible = Me.FRM_TFX.Form.Recordset.RecordCount > 0 End Sub وقد تجد الاجابة للشق الثاني من الزملاء إن شاء الله تعالى ...

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

اتفضل وهذا مرفقكم بعد التعديل valu (1).accdb مفيش أي تعب تحت امر حضرتك يا اهلا بيك

الاستاد هدا مجرد مثال الفكرة واحدة اي حقل ينطبق علية الفكرة تمام c1 او c2 `واعتذر منك لاتعابك معي ولو انكم تعودتم على مثل هكذا اخطاء

الحمد لله .. ومصباح علاء الدين هذا إلك فيه دور أخي الكريم ابا جودى وكل الشكر للأخوين الكريمين husamwahab & ابا جودى وتم المطلوب بحمد الله والحاصل من كل ما سبق: تعلمتُ كيفية حذف سجلات من (..) إلى (..) عبر الاستعلام إذا احتجت لهذا الأمر في بعض الأحيان وإذا كنت أريد إدراج هذا الإجراء في النماذج لتكرار الحاجة إليه فأستخدم الوحدة النمطية، مع الأمر التالي إذا كان مصدر البيانات هو الجدول نفسه Call SpDelRec(Me.RecordSource, "TNO") Me.Requery أما إذا كان مصدر البيانات استعلام فأستخدم الأمر التالي Call SpDelRec("TAB_RMZ", "TNO") Me.Requery مع تغيير اسم الجدول حسب المطلوب

آمل النظر في الملاحظات أعلاه وهذا هو مطلوبك بدون أي تعديل آخر: ايقاف عد الشهور الى 12 او 24 (1).xls

ماشى حظك حلو ماشاء الله جالك الأستاذ @husamwahab ومعاه مصباح علاء الدين حقق امانيك

لأ هيك كثييير .. إذا كنت إنت مش مبرمج يعني أنا لسه مش مبتدئ 😁 والطلب اللي طلبتو .. طلبتو لأني شفت أكواد فيها نفس الفكرة .. أو نفس الذكاء .. بتجيب اسم الجدول لحالها بدون ما حدا يحكيلها ما تسألني وين هاي الأكواد .. لأني نسيت 🙃

جزاك الله خير الثواب وكل عام وانتم جميعاً بخير

بعد إذن الأستاذ / مهندس الإكسيل المعادلة هذه والسحب نزولاً تفي الغرض =IF(AND(A1="غ";B1="غ";C1="غ");"غ";IF(SUM(A1:C1)=0;"صفر";SUM(A1:C1))) أو تبع إعدادات جهازك =IF(AND(A1="غ",B1="غ",C1="غ"),"غ",IF(SUM(A1:C1)=0,"صفر",SUM(A1:C1))) ولا داعي لرفع الملف مضغوط طالما حجمه صغير جمع الغياب.xls

بارك الله فيك وجزاك الله خير

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

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

موضوع مهم جداً ، بوركت الجهود ، متابع بصمت

استاذي العزيز nssj بالخدمة الكود ماخوذ من استعلام حذف ووضعت قبله DoCmd.RunSQL Tab04.rar

الله يجزيكم الخير وكل عام وأنتم بألف خير

تفضل التعديل aaa.rar

هذا الكود يحول الى وورد ولكن يتعين عليك تعديل اعددات الصفحة في الوورد من حيث الصفحة افقية او راسية وغيره Sub wordexport() Set Word = CreateObject("Word.Application") Word.Documents.Add Word.Visible = True Range("E1:Q1010").Copy Word.Selection.PasteExcelTable False, False, False Application.CutCopyMode = False End Sub

الرد على هذا الموضوع ولم اتمكن ربما تم اقفال الموضوع فيا حبذا لو تكرم احد المشرفين بوضع ردي تحت الموضوع اعلاه ردي هو : هذه بعض التفاصيل عن دالة حساب العمر لم تذكر في الشرح حساب الأيام والشهور والسنوات بين تاريخين.pdf DATEDIF.xlsx

استاذي العزيز abouelhassan انا بالخدمة ورحم الله والديك على هذا الدعاء وانت بالف خير وصحة وسلامة

جزاكم الله كل خير جميعا. وأحب أن أبشركم بأني في طريقي للانتهاء من برمجة أقصر واسرع كود للتفقيط (54 سطر برمجي) متعدد اللغات ويمكن تخصيصه لجميع العملات وموافق لقواعد اللغة العربية واللغة الإنجليزية. ولكن نظرا لاهتمامي بلغة الويب قمت بعمله أولا في هذه الصفحة أونلاين https://www.mr-mas.com/p/tafqeet.html وجاري تحويله ليعمل على فيجوال بيسك للتطبيقات vba تابعونا

الطريقة الثانية هنا الاستبدال بالاختيار ، عن طريق بلوكات يتم حفظها و تستدعي يدويا او كما يسمي Building Block و الطريقة كالتالي لنفرض أنك تريد توفير وقت كتابة جملة السلام عليكم و رحمة الله وبركاته اكتبها فى الملف لاول مرة ثم اخترها و اضغط ALT+F3 سيظهر لك المربع التالي و سنحفظها باسم السلام ضمن العبارات المحفوظة Building Block و هكذا تم حفظها و لاستدعاءها من قائمة Insert اختار Quick Parts Building Blocks organizers ثم اختار الجملة التي تريد ادراجها و سيتم ادراج الجملة المحفوظة المطلوبة و طبعا يمكنك اختصار الخطوات عن طريق اضافة ال quick Parts الى قائمة الاختصارات السريعة فتظهر كايقونة يمكن الوصول اليها سريعا و اختصار الخطوات السابقة كما هو مبين فى الصورة التالية ثانياً : من ناحية اخرى ستجد الوورد يقترح عليك الاستبدالات المسجلة عندما تكتب بعض الجروف دون الحاجة لادراج المكونات يدويا مثلما هو مبين فى الصورة التالىة و كل ما عليك هو ضغط Enter ليتم ادراج الجملة بالكامل 😄 ثالثاً: أيضا هناك حل آخر اذا لم يظهر لديك الاقتراح كما سبق ان تكتب كلمة السلام ثم تختارها دون زيادة مسافات فى النهاية ثم تضغط F3 و سيتم الاستبدال مباشرة من القائمة المخزنة

السلام عليكم ورحمة الله وبركاته بسم الله الرحمن الرحيم أتمنى من الله أن تكونوا جميعا بألف خير وصحة وصيامكم خفيف ومقبول إن شاء الله موضوع اليوم هو تجميعة للأكواد الخاصة بحفظ الإكسل كـ PDF سواء الصفحات أو النطاقات أو ملفات الإكسل كاملة مع إمكانية إرسالها عن طريق الأوت لوك Outlook الملف المرفق بيه كل الأكواد المستخدمه يمكنك التعديل عليها بما يتناسب مع إحتياجك يحتوي الملف على أكواد تقوم بعمل التالي بإذن الله سيتم قريبا طرح موضوع عن إرسال الـ PDF من الإكسل عن طريق الإيميل ولكن ليس بواسطة Outlook ولكن بعد الـ Mail Clients الأخرى أو حتى بدون برنامج للإيميلات ==== رابط للإخوة الزائرين http://www.up-00.com/?4Jrg ودمتم في رعاية الله PDF and EMIL.rar

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

السلام عليكم في هذا الكود يقوم بترحيل بيانات من النمودج الى الجدول DoCmd.SetWarnings False DoCmd.RunSQL "insert into tbc(idn, cdatex, c1,c2 )VALUES (idn,tdatex,c1,c2)" DoCmd.SetWarnings True في الحقل c1 لا اريد الكود يرحل البيانات من الحقل c1 اريد ان اكتب قيمة الترحيل بشكل يدوي كمثال اريد ان تكون قيمة الحقل c1 في الجدول بعد الترحيل تساوي Rm فكيف تكون كتابة الكود

c2😅