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

وعليكم السلام ورحمة الله وبركاته الكود يعمل تلقائيا عند الانتهاء من الكتابة في خلية والخروج منها New Microsoft Excel Worksheet (2).xlsb

وعليكم السلام ورحمة الله تعالى وبركاته جرب هذا Sub Remplissez_jours_dates() Dim début As Date, DateFin As Date, CrDate As Date Dim tmp As Long, DayArr As Variant Dim WS As Worksheet: Set WS = Sheets("البنين") If WS.Range("K2").Value = "" Or WS.Range("O2").Value = "" Or _ Not IsDate(WS.Range("K2").Value) Or Not IsDate(WS.Range("O2").Value) Then MsgBox "يرجى التأكد من صحة التواريخ ", vbExclamation Exit Sub End If début = WS.Range("K2").Value DateFin = WS.Range("O2").Value If début > DateFin Then: MsgBox "لا يمكن أن يكون تاريخ البدءأكبر من تاريخ الانتهاء", vbExclamation: Exit Sub Application.ScreenUpdating = False WS.Range("E4:AH5").ClearContents DayArr = Array("الأحد", "الاثنين", "الثلاثاء", "الأربعاء", "الخميس") tmp = 4 CrDate = début Do While CrDate <= DateFin If Weekday(CrDate, vbSunday) <> 6 And Weekday(CrDate, vbSunday) <> 7 Then If tmp > 34 Then Exit Do WS.Cells(4, tmp).Value = DayArr(Weekday(CrDate, vbSunday) - 1) WS.Cells(5, tmp).Value = CrDate tmp = tmp + 1 End If CrDate = CrDate + 1 Loop Application.ScreenUpdating = True End Sub وفي حدث ورقة البنين Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Me.Range("K2,O2")) Is Nothing Then Remplissez_jours_dates End If End Sub جدول الحصص الإضافية.xlsb

وعليكم السلام ورحمة الله وبركاته الكود Sub CreateBackup() Dim wb As Workbook Dim folderPath As String Dim fileName As String Dim fileExtension As String Dim backupName As String Dim backupNumber As Integer Dim fso As Object Dim file As Object Set wb = ThisWorkbook folderPath = wb.Path & "\" fileName = Left(wb.Name, InStrRev(wb.Name, ".") - 1) fileExtension = Mid(wb.Name, InStrRev(wb.Name, ".")) Set fso = CreateObject("Scripting.FileSystemObject") backupNumber = 0 For Each file In fso.GetFolder(folderPath).Files If InStr(file.Name, fileName) = 1 And InStr(file.Name, fileExtension) > 0 Then Dim currentNumber As Integer On Error Resume Next currentNumber = CInt(Mid(file.Name, Len(fileName) + 1, InStrRev(file.Name, fileExtension) - Len(fileName) - 1)) On Error GoTo 0 If currentNumber > backupNumber Then backupNumber = currentNumber End If End If Next file backupName = folderPath & fileName & (backupNumber + 1) & fileExtension wb.SaveCopyAs backupName MsgBox "تم إنشاء نسخة احتياطية باسم: " & vbCrLf & backupName, vbInformation, "نسخة احتياطية" End Sub الملف Ehab.xlsb

مشاركتاً مع استاذنا @Barna تفضل استاذ @2saad المرفق بعد التعديل حسب مافهمت بالتقرير (tozeagalos) . ووافني بالرد . البحث وتعديل درجات9.rar

توليد رمز الاسم من الثنائي وحتى السداسي Dim rs As Recordset Dim na1, na2, na3, na4 As String On Error Resume Next Set rs = CurrentDb.OpenRecordset("QAAA") rs.MoveLast rs.MoveFirst Do While Not rs.EOF rs.Edit rs!Rmz = Mid(Split(rs!AsmGded, " ")(0), 1, 2) & Mid(Split(rs!AsmGded, " ")(1), 1, 2) & _ Mid(Split(rs!AsmGded, " ")(2), 1, 2) & Mid(Split(rs!AsmGded, " ")(3), 1, 2) & _ Mid(Split(rs!AsmGded, " ")(4), 1, 2) & Mid(Split(rs!AsmGded, " ")(5), 1, 2) rs.Update rs.MoveNext Loop End Sub نموذج بحث6.rar

مشاركة من الحبيب @ابوخليل انظر اخي @يونس محمد الخطابي المرفق التالي يقوم بمهام : استخلاص رمز ( الحرفين الاول من الاسم الاول - الاسم الثاني - الاسم الثالث - بالاضافة للحرفين الاول للعنوان ) وذلك عن طريق الاستعلام GeneratedCodeQuery SELECT TAAA.Idd3, TAAA.Asm, TAAA.Anoan, Left(Trim(Mid([asm],1,InStr(Trim([asm]),' ')-1)),2) & IIf(InStr(Trim([asm]),' ')>0,Left(Trim(Mid([asm],InStr(Trim([asm]),' ')+1,InStr(InStr(Trim([asm]),' ')+1,Trim([asm]),' ')-InStr(Trim([asm]),' '))),2),'') & IIf(InStr(InStr(Trim([asm]),' ')+1,Trim([asm]),' ')>0,Left(Trim(Mid([asm],InStr(InStr(Trim([asm]),' ')+1,Trim([asm]),' ')+1)),2),'') & Left(Trim([Anoan]),2) AS Rmz FROM TAAA WHERE (((Left(Trim(Mid([asm],1,InStr(Trim([asm]),' ')-1)),2) & IIf(InStr(Trim([asm]),' ')>0,Left(Trim(Mid([asm],InStr(Trim([asm]),' ')+1,InStr(InStr(Trim([asm]),' ')+1,Trim([asm]),' ')-InStr(Trim([asm]),' '))),2),'') & IIf(InStr(InStr(Trim([asm]),' ')+1,Trim([asm]),' ')>0,Left(Trim(Mid([asm],InStr(InStr(Trim([asm]),' ')+1,Trim([asm]),' ')+1)),2),'') & Left(Trim([Anoan]),2)) Like "*" & [forms]![NAAA1]![DDD] & "*")); جرب عملية البحث الان بعد اضافة عناوين ..... واعلمنا بالنتيجة Barna_5.accdb

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

حمد لله على سلامتك أستاذ خليفة . ونسأل الله أن تكون بصحة وعافية 💐

عودة ميمونة الرجل الطيب @kkhalifa1960 الحمد لله على السلامة

تفضل أخي @nabilbibo2255 حسب مافهمت . ووافمي بالرد . DD12-2024-1.rar

هذه الرموز اشرت اليها لابين الفرق بين تشفيري كلمة المرور بين قاعدة مفتوحة واخرى محولة الى accde اخيرا الطريقة جميلة كما اشرت وتتلخص في تشفير قاعدة البيانات رقم 1 بكلمة مرور وهذا النوع يصعب كسره للاصدارات 2007 فما فوق ☝️ هذه مداخلة اخي جعفر واتفق معه فيما اشار اليه وهناك قاعدة بيانات رقم 2 تقوم بفتج القاعدة رقم 1 وتمرر لها كلمة المرور وهنا مربط الفرس ولكن هل الامر يستحق عناء البحث الصورة مجرد تلميح 👇

السلام عليكم ورحمة الله تعالى وبركاته طبعا قد يقول البعض ان الموضوع اتهرس فى ميت فيلم عربى قبل كده لكن على كل حال تم تدارك الكثير من المشاكل ومعالجتها بشكل احترافى - اخفاء اطار لاكسس بالشكل الطبيعى والتقليدى لعرض النموذج كاملا - اخفاء اطار الاكسس وعمل شفافية للنموذج لاظهار صور png او حسب خيال المسخدم - تم ضبط كواد التوسيط للنماذج والتقارير باحترافية ويعمل التوسيط مع الخاصية Pop Up فى اى وضع كانت فى حالة عدم استخدام الاخفاء - تم حل مشكلة عدم ظهور التقاربر عند الاخفاء بتكبير التقرير تلقائيا عند استخدام كود الاخفاء - امكانبة التصغير للتطبيق بجوار الساعة ( System Try ) - عند التصغير بجوار الساعة ممكن الضغط كليك يمين على الايقونة لتظهر قائمة اختيارات - تم ضبط كود تغير ايقونة الاكسس باحترافية وبشكل تلقائى من المسار المحدد او فى حالة عدم وجود الايقونة ترجع ايقونة الاكسس - تم التعامل مع الاكواد بحرفية تامة للعمل على بيئات الأنوية المختلفة سواء كانت 32 , 64 اترككم مع تجربة شيقة ملاحظة هامة : ارضاء للجميع ولاضفاء اكبر قدر ممكن من المرونة المرفق يحتوى على قاعدتان الاولى : تم تجميع كل الاكواد والدوال فى وحدة نمطية عامة واحدة وكلاس موديول واحد لسهولة الاستفادة منها ونقلهم الى اى قاعدة الثانية : فصل اكواد كل وظيفة على حدة فى مديول خاص بها تم اضافة تعديل وتحديث جديد بتاريخ 11/10/2024 رقم اصدار التعديل الاخيــر : 4.8 center and Hid and Tray Minimizer V 30.zip center and Hid and Tray Minimizer V 4.8.rar

ما شاء الله عمل مميز جدا.... كعادتك أبا جودي مبدع زادك الله علما وفهما

وعليكم السلام ورحمة الله وبركاته أخي @nabilbibo2255 ، وأهلاً وسهلاً بك معنا في اسرة هذا المنتدى الكبير . أولاً أدعوك للمساهمة في تطبيق أساسيات وقوانين المنتدى عند نشر أي موضوع ، بحيث :- 1. يكون العنوان صريح ودال على المطلوب . 2. الشرح الوافي الكافي الشافي للمشكلة . 3. ارفاق ملف مرفق يساعد ويدعم في إيجاد حل على أرض الواقع . 4. لا تحاول استخدام مسميات الحقول والعناصر في المشروع بأسماء عربية أو ذات رموز أو أرقام فقط . أما فيما يتعلق بسؤالك ، فأنصحك باستعمال علامات التكويد <> لوضع الكود بدلاً من الصورة ، ليسهل قراءته والتعامل معه ممن يحاول ان يساعدك في الحل . لاحظت ان الكود يعمل بشكل سليم إلى حد ما ، ولكن المشكلة تكمن في الشروط التي على أساسها سيتم فتح النموذج . Private Sub Form_Load() On Error Resume Next Dim xx As Integer xx = Nz(DCount("[IDEmp]", "fin_ssolde"), 0) If xx > 0 Then Beep If MsgBox("هناك " & xx & " موظف(ين) انتهت عقودهم. هل ترغب في عرض التفاصيل؟", _ vbYesNo + vbMsgBoxRight, "تنبيه") = vbYes Then DoCmd.OpenForm "fin_ssolde", acNormal Else DoCmd.OpenForm "frm_F20", acNormal End If Else DoCmd.OpenForm "frm_F20", acNormal End If End Sub حاول وأخبرنا بالنتيجة ..

وعليكم السلام ورحمة الله وبركاته الاكسل يمكنه التعامل مع الأرقام التي تصل إلى 15 رقمًا وسيحول الأرقام المتبقية إلى أصفار عن طريق كود يمكن عمل طلبك بشرط تحويل النطاق المراد الكتابة فيه الى نص شاهد المرفق ويمكنك تعديل النطاق من الكود format cell.xlsb

ما شاء الله لا قوة الا بالله زادكم الله عزة ورفعة

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

السلام عليكم ورحمة الله تعالى وبركاته تم تلافى الكثير من المشاكل وتم تحديث النسخة اليوم اليكم الاصدار الجديد ان شاء الله فى رأس الموضوع أو يمكنكم تحميل التعديل الاخيــر من >>---> تحميل التحديث للإصدار الأخير

أساتذتى الكبار أخوتى وأخواتى فى منتدى أوفيسنا أنا فخور انى أحد أعضاء المنتدى الكريم ده دائما ما نجد ضالتنا فيه لقيت الملف ده على موقع أجنبى وبصراحه عجبنى وحبيت أشارك بيه أحلى طاقم عمل فى المنتدى الى أن يتم شرحه وتفكيكه من عباقرة المنتدى مرفق ومنتظر اراءكم يارب يعجبكم New-Userform-.rar

السلام عليكم ورحمة الله وبركاته هل تعني أن يكون معرباً كما في المرفق يرجى أن يرضيكم New-Userform-.rar

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