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

وعليكم السلام ورحمة الله تعالى وبركاته إليك الكود المطلوب لحفظ جميع الشهادات في ملف PDF داخل مجلد باسم برنامج الكنترول شيت في نفس مكان المصنف Option Explicit Private Const CopyRange As String = "A5:J49" Private Const sFolder As String = "برنامج الكنترول شيت" Private Const NamePDF As String = "شهادات الأول" Private Const CrWS As String = "شهادات الأول بالقديرات" Private Sub CommandButton1_Click() Dim tbl As Boolean: tbl = False On Error GoTo CleanExit Dim f As Worksheet: Set f = Sheets(CrWS) Dim WS As Worksheet, début As Integer, fin As Integer, i As Integer, row As Integer Dim sPath As String, tempFile As String, tmp As Long, Rng As Range, OnRng As Range If IsEmpty(f.[J3].Value) Or Not IsNumeric(f.[J3].Value) Then _ MsgBox "يرجى تحديد رقم أول شهادة", vbExclamation, "تنبيه": Exit Sub début = f.[J3].Value: fin = f.[R3].Value If début < 1 Or fin < 1 Or début > fin Then Exit Sub If MsgBox("هل ترغب بحفظ الشهادات من " & _ début & " إلى " & fin & "؟", vbYesNo + vbExclamation, "تأكيد") = vbNo Then Exit Sub SetApp False On Error Resume Next Set WS = Sheets("PDF") If Not WS Is Nothing Then Application.DisplayAlerts = False: WS.Delete: Application.DisplayAlerts = True Set WS = Sheets.Add(After:=Sheets(Sheets.Count)) WS.Name = "PDF": WS.DisplayRightToLeft = True On Error GoTo 0 If WS Is Nothing Then: GoTo CleanExit tempFile = ThisWorkbook.Path & "\" & sFolder If Dir(tempFile, vbDirectory) = "" Then MkDir tempFile tmp = 1 Set OnRng = f.Range(CopyRange) For i = début To fin Step 5 f.[J3].Value = i: Set Rng = WS.Cells(tmp, 2) OnRng.Copy Rng.PasteSpecial Paste:=xlPasteValues: Rng.PasteSpecial Paste:=xlPasteFormats Rng.PasteSpecial Paste:=xlPasteColumnWidths For row = 1 To OnRng.Rows.Count WS.Rows(tmp + row - 1).RowHeight = OnRng.Rows(row).RowHeight - 1.5 Next If i + 5 <= fin Then WS.HPageBreaks.Add Before:=WS.Cells(tmp + OnRng.Rows.Count, 1) tmp = tmp + OnRng.Rows.Count + 1 Next With WS.PageSetup .Orientation = xlPortrait: .Zoom = False: .FitToPagesWide = 1: .FitToPagesTall = False .TopMargin = Application.InchesToPoints(0.5): .BottomMargin = Application.InchesToPoints(0.5) .LeftMargin = Application.InchesToPoints(0.2): .RightMargin = Application.InchesToPoints(0.2) .PaperSize = xlPaperA4: .CenterHorizontally = True: .CenterVertically = False End With sPath = tempFile & "\" & NamePDF & ".pdf" On Error Resume Next WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False tbl = (Err.Number = 0) On Error GoTo 0 f.[J3].Value = 1 WS.Delete CleanExit: SetApp True MsgBox IIf(tbl, _ "تم تصدير جميع الشهادات بنجاح" & vbNewLine & _ "تم حفظ الملف باسم: " & NamePDF & vbNewLine & "في المجلد: " & sFolder, _ "حدث خطأ يرجى المحاولة مرة أخرى"), IIf(tbl, vbInformation, vbCritical), _ "PDF" & "تصدير الشهادات بصيغة" End Sub Private Sub SetApp(ByVal enable As Boolean) With Application .ScreenUpdating = enable: .EnableEvents = enable: .DisplayAlerts = enable End With End Sub وإليك في المرفقات شكل الملف PDF المستخرج بعد تنفيذ العملية لتأخذ فكرة واضحة عن النتيجة النهائية شهادات الأول والثانى- الصف الأول.rar شهادات الأول.pdf

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

وعليكم السلااااااام ورحمة الله وبركاته .. يا هلا بالأفكار النيرة ، والإبداعات المثيرة . تحفة فنية جمية منسوجة بإحكاااااام و براعة عند قراءة الفكرة وبتمعن ، خطر لي سؤال :- ماذا يحدث عند نقل قاعدة البيانات إلى جهاز جديد ؟؟؟؟؟ ( هل سيتم نقل بيانات الاعتماد تلقائياً ؟ ) لكن جوهر الفكرة جميل جداً بأفكار صاحب الأفكار الجميلة ,,,

صحيح هذا تصحيح للمثال كما تفضلت .. لعله يناسب ابو عبدالله AcademicYear2.rar

فتح نفس النموذج لعدد غير محدود

انا كنت اعمل على المثال .. وسبقتني 👍 يوجد حل افضل .. وهو تحويل القائمة الى مربع نص وهنا لن يكون بحاجة الى جدول السنوات Academicyeartble

تمام استاذنا .. ويمكن وضع ضابط من اجل تجاوز الخطأ فيما لو لم تكن القيمة موجودة ضمن القائمة

وعليكم السلام ورحمة الله وبركاته ,, جرب هذه الفكرة البسيطة ، في حدث بعد التحديث لمربع نص تاريخ الإجتماع :- Private Sub MeetingDate_AfterUpdate() Me.Academic_Name = Me.Text7 End Sub طبعاً هذا سيعتمد على تحديث القيم في القائمة المنسدلة بشكل تلقائي كل سنة دراسية على سبيل المثال , AcademicYear.accdb

وعليكم السلام ورحمة الله وبركاته اليك الكود المتاسب لطلبك Sub call1() Sheets("ff").Range("D3:U3").ClearContents Dim i As Integer For i = 1 To Sheets.Count Sheets("ff").Cells(3, 3 + i) = Sheets(i).Name Next i End Sub

السلام عليكم بالاشارة الى الموضوع التالي ، والطرق التي تمت الاشارة اليها : في المشاريع اللي احتاج لها اعدادات ، كنت استعمل جدول بسطر واحد ، ولكن في احد مشاريعي ، هذه الاعدادات وصلت الى 21 ولا تزال في زيادة ، فعملت تغيير في الجدول ، واصبح هناك سجل خاص لكل واحدة من الاعدادات: . . وهذا شكل النموذج المستمر للمستخدم: . وبياناته : . ونعرف انه في النموذج المستمر ، لا نستطيع التحكم بشكل حقل دون آخر (إلا عن طريق التنسيق الشرطي ، وعن طريق كود خاص يخص مربع الزر Command button) ، لذلك كان من المهم ان اكتب عبارة معين في اسم الحقل حتى اميزه عن الآخرين (او ان اعمل حقل اكتب فيه طريقة التعامل مع هذا السجل (استفيد منه في التنسيق الشرطي مثلا)) ، لذا نرى ان زر (command button) جميع الحقول التي بحاجة الى اختيار مجلد لها ، بدأ اسم الحقل بالكلمة Path (طبعا هذا مثال) ، وعليه استطعت ان اخفي الزر لبقية السجلات هكذا: Private Sub Detail_Paint() If Left(Me.sName, 4) <> "Path" Then Me.cmd_Path.Transparent = True Else Me.cmd_Path.Transparent = False End If End Sub وعند فتح البرنامج ، اقوم بتشغيل هذه الدالة حتى يتم استيراد البيانات من الجدول الى ذاكرة اكسس : Option Compare Database Option Explicit ' '- tbl_Settings contain the defaults for this program, '- instead of having all these fields in one record, '- we have records of these fields sName, sValue, sDataType '- so here we deal with these values, read/write ' '- jjafferr '- v1. 17/04/2025 ' Function tbl_Settings_Data() '- load the values for the table to TempVars, for each field Dim rstS As DAO.Recordset Dim RC As Long, i As Long Set rstS = CurrentDb.OpenRecordset("Select * From tbl_Settings") rstS.MoveLast: rstS.MoveFirst: RC = rstS.RecordCount For i = 1 To RC '- clean the old values of THIS record TempVars.Remove (rstS!sName) '- since TempVars is Variant, lets set the actual field values based on the field sDataType If rstS!sDataType = "Number" Or rstS!sDataType = "Yes/No" Then TempVars.Add (rstS!sName), CLng(rstS!sValue) ElseIf rstS!sDataType = "Text" Then TempVars.Add (rstS!sName), CStr(rstS!sValue) ElseIf rstS!sDataType = "Date/Time" Then TempVars.Add (rstS!sName), CDate(rstS!sValue) End If rstS.MoveNext Next i rstS.Close: Set rstS = Nothing End Function Function ListTempVars() '- list all TemVars values in this Database Dim i As Long For i = 0 To TempVars.Count - 1 Debug.Print TempVars(i).Name, TempVars(i).Value, VarType(TempVars(i)) Next i End Function Function Update_a_Field(New_Value As String, Field_Name As String) ' ' usage from the Form, for example: ' Call Update_a_Field(Forms!frm_Main!BG_Pixel_Color, "Color_Reference") ' '- update the field value in the table DoCmd.SetWarnings False 'DoCmd.RunSQL ("UPDATE tbl_Settings SET sValue =" & Me.BG_Pixel_Tolerance & " WHERE sName='Color_Tolerance'") DoCmd.RunSQL ("UPDATE tbl_Settings SET sValue =" & New_Value & " WHERE sName='" & Field_Name & "'") DoCmd.SetWarnings True '- update the TempVar TempVars.Remove (Field_Name) '- Remove the field TempVars.Add (Field_Name), New_Value '- add the field with the new value End Function . وعليه ، وعند طلب اي قيمة في البرنامج ، استعمل: اسم الحقل في الجدول Path_Employees_Pic_Folder طريقة طلب القيمة TempVars!Path_Employees_Pic_Folder طريقة استعماله Me.Picture = TempVars!Path_Employees_Pic_Folder & Me.Employee_ID & ".jpg" . السبب الذي جعلني استخدم TempVars يدلا عن الاكواد العامة او الدوال الخاصة هو ، اني اخذ البيانات من الجدول مرة واحدة فقط عند تشغيل البرنامج ، وهذه البيانات تبقى في ذاكرة البرنامج حتى عند استلام رسالة خطأ (عند ظهور رسالة الخطأ ، يقوم اكسس بحذف جميع المتغيرات التي بذاكرنه ، ما عدا بيانات TempVars) ، وبكل بساطة يمكننا قراءة قيمتها من نافذة immediate window في صفحة الكود هكذا: . رجاء ملاحظة ان علامة الاستفهام يجب ان تكون بالانجليزي. ---------------------------------------------------------- 30-05-2025 تم اضافة كود تحديث بيانات الجدول و TempVars ، واتضح انه اسهل مما كنت اتوقع 🙂 جعفر

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

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

اعرض الملف 🧮>> لعبة مطابقة الأرقام <<🧮 :: هدية خفيفة :: لتنمية مهارة التركيز 😉👌 :: السلام عليكم ورحمة الله وبركاته 🙂 🖐🌷 :: اليوم جايب لكم هدية خفيفة وظريفة 😊🎁 🧮🧮>> لعبة مطابقة الأرقام <<🧮 وأنا جالس مع الأولاد قلت أعلمهم شوية أكسس وأحنا بنلطش فيه ( بنخبص فيه 😅) جات لنا فكرة هذي اللعبة وجلسنا نطور فيها أنا والأولاد بأفكارهم الجميلة وتنفيذي المتواضع 😊 لحد ما وصلنا للنتيجة هذي . وهذي صورة اللعبة : وكيفية اللعب : :: ولا تنسونا من صالح دعواتكم 😊🤲:: صاحب الملف Moosak تمت الاضافه 05/30/25 الاقسام قسم الأكسيس  

هههههههههههههههه ما شاء الله فى كل مره بخسر ((فعلا اللعبه وقفت معايا لما سجلت اسمي انجليزي لكن لما كتبته عربي اشتغل عادي ^_^)) يا عم طلع التركيز بتاعي 0 ههههههههههههه

السلام عليكم ورحمه الله وبركاته ممكن تستخدم الكود التالي عند ظهور الاخطاء الخاصه من 32 الي 64 Private Declare Function استبدلها الي Private Declare PtrSafe Function ----------------------------------------------------------------- Private Declare استبدلها الي Private Declare PtrSafe

. 1. هي عادة احاول التمسك بها ، مثل عند الانتهاء من عمل Recordset ، فلا يوجد داعي لإستعمال set rst=Nothing ، ولكنها عادة جيدة خصوصا لما يكون عندك مجموعة من Recordsets 🙂 2.1. الحد الاقصى لـ TempVars هو 255 متغير فقط ، 2.2. هذه الطريقة استعملها فقط لجدول اعدادات البرنامج ، ولا اعتقد انها ستتعدى 30-40 معلومة ، وكما قلت سابقا:

السلام عليكم ورحمة الله وبركاته جرب التعديل التالى حسب طلبكم الاخير وفقكم الله طريقة اخرى للبحث معدلة5.xlsb

تفضل أخي الكريم توحيد البحث في شيت واحد v5 .xlsb

أحسنت الرد أحي الكريم الأستاذ / @محمد هشام.

شكر وتقدير واجب أخي الأستاذ / @عبدالله بشير عبدالله أخي الأستاذ / @محمد هشام. أخي الأستاذ / @Foksh

في العادة الحد الافصى لطول لكيبل الشبكة من نوع cat6 و cat7 و cat8 بحدود 100 متر بشرط ان يكون الكيبل من نوعية جيدة ومعزول بشكل صحيح والفرق بينهم يكون في سرعة النقل وعرض النطاق وكلما زاد طول الكيبل تقل السرعة ويزداد التشويش وفقد البيانات فمثلا كات6 يمكن الحصول على السرعة القصوى اذا كان الكيبل اقل من 55 متر وكات 7 في حدود 30 متر فقط اما الكات 8 فالحد الاقصى للحصول على سرعة نقل كاملة يتطلب ان يكون طول الكيبل لا يزيد عن 100 متر لذا عند زيادة المسافة عن 40 متر يتطلب استخدام سويتشات من نوعية تدعم السرعة المناسبة لنوع الكيبل ويستثنى الكات8 حيث يمكن وضع سوتشات كل 90 متر في جميع الاحول لمسافة 1000 متر او اكثر يكون استخدام هذا النوع من الكيابل والسويتشات امر غير مجدي واعتقد ان الخيار الامثل استخدام كيابل الفايبر حينها لن يكون هناك فقد للبيانات والاهم لن يكون هناك اختناق او عنق زجاجة يمكن للكيبل الفايبر الاحادية نقل بيانات لمسافة 100 كيلو متر او اكثر عند بناء الشبكة نهتم بسعة النطاق اكثر من الاهتمام بالسرعة سعة النطاق لكيبل cat8 وهو افضل كيبل من سلسلة كات فقط 2000 ميجا هيرتز بينما في الفايبر تكون سعة النطاق ما بين 40 الى 100 جيجا في الثانية انا هنا اتحدث الكيابل احادي الوضع والله الموفق

تم اضافة كود تحديث بيانات الجدول و TempVars ، واتضح انه اسهل مما كنت اتوقع 🙂 Function Update_a_Field(New_Value As String, Field_Name As String) ' ' usage from the Form, for example: ' Call Update_a_Field(Forms!frm_Main!BG_Pixel_Color, "Color_Reference") ' '- update the field value in the table DoCmd.SetWarnings False 'DoCmd.RunSQL ("UPDATE tbl_Settings SET sValue =" & Me.BG_Pixel_Tolerance & " WHERE sName='Color_Tolerance'") DoCmd.RunSQL ("UPDATE tbl_Settings SET sValue =" & New_Value & " WHERE sName='" & Field_Name & "'") DoCmd.SetWarnings True '- update the TempVar TempVars.Remove (Field_Name) '- Remove the field TempVars.Add (Field_Name), New_Value '- add the field with the new value End Function . اخوي موسى: عندي برنامج ، على حاسبتين او ثلاث ، يطبعون منه حوالي 1000 وصل خلال نصف ساعة ، وبه صورتين وبيانات اخرى ، والسيرفر بعيد حوالي كيلومتر او اثنين (اذا تحسب اطوال كيبلات الشبكة) ، تصور اذا كنا نطلب مسار الصور كلما اردنا طباعة وصل

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

وعليكم السلام ورحمة الله تعالى وبركاته إذن أخي الكريم على الأقل قم بإرفاق ملفك وبه الأكواد المطلوبة مع ذكر النواة التي تستخدمها حاليا هل هي 32 أو 64 لتوضيح ما يظهر معك من أخطاء عند محاولة تنفيذ الكود لا يمكن العمل على التخمين !!!

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

جرب هدا Sub ConvertDates() Dim WS As Worksheet, lastRow As Long, i As Long Application.ScreenUpdating = False Set WS = ActiveSheet lastRow = WS.Cells(WS.Rows.Count, "L").End(xlUp).Row For i = 2 To lastRow If IsDate(WS.Cells(i, "L").Value) Then WS.Cells(i, "M").Value = DateValue(WS.Cells(i, "L").Value) WS.Cells(i, "M").NumberFormat = "mmm dd, yyyy" Else WS.Cells(i, "M").Value = "" End If Next i Application.ScreenUpdating = True End Sub

وعليكم السلام ورحمة الله تعالى وبركاته، شكرًا للأخ @Foksh على مشاركته القيمة وبعد إذنه طبعا بالفعل الدالة: =TEXT(L2, "mmm dd, yyyy") مفيدة جدا لإظهار التاريخ بتنسيق واضح لكنها ترجع نصا وليس تاريخا فعليا مما قد يعيق عمليات مثل الترتيب أو الفلترة أو الحسابات المرتبطة بالتواريخ كبديل يعيد قيمة التاريخ الأصلية بدون الوقت وبشكل يمكن Excel التعامل معه كتاريخ حقيقي يمكن استخدام: =INT(L2) أو =QUOTIENT(L2, 1) كلاهما يفصل التاريخ عن الوقت تماما (وتظل قابلة للحسابات مثل التصفية والفرز) ملاحظة: تأكد من تنسيق الخلايا الناتجة كـ [تاريخ] لضمان عرضها بالشكل الصحيح وإذا كنت مهتما أيضا بفصل الوقت بشكل مستقل فيمكن استخدام: =L2 - INT(L2) وهي مفيدة إذا احتجت لاحقا إلى عرض الوقت وحده أو تحليله تحياتي وتقديري للجميع 2 تمديد.xlsx