اذهب الي المحتوي
أوفيسنا

Foksh

أوفيسنا
  • Posts

    3740
  • تاريخ الانضمام

  • Days Won

    152

كل منشورات العضو Foksh

  1. وعليكم السلام ورحمة الله وبركاته 🤗.. كفكرة ، قم بإنشاء تقرير يجلب الصور من مساراتها ، ثم قم بتصدير التقرير إلى ملف PDF . أعتقد هذا أنسب حل لك 😉 . أتابع من الجوال
  2. اممممممممم .. طيب جرب هذا التعديل ؟ الإستعلام الأصلي السابق ، وفي حدث في الحالي تعيين قيمة مربع النص الخاص بالترتيب .. baseC5.zip
  3. بالطبع اخي الكريم كلا ، هذا استعلام فرعي داخل استعلام رئيسي المرفق للتوضيح أكثر baseC4.zip
  4. وعليكم السلام ورحمة الله وبركاته ,, هذا يعني انه يمكن ان يكون المعيار مختلفاً !!!! طيب ، أمامك حلين اثنين في الوقت الحالي .. الأول من خلال معادلات مع الإستعانة بخلية ( عمود مساعد ) . وسيكون الحل كالآتي :- سنجعل المعايير متغيره بحيث يتم ادخال عدد الذكور والإناث وعدد القاعات في الخلايا ( i5 , j5 , h5 ) في الخلية المساعدة ولنفترض E2 ، نستعمل هذه المعادلة :- =IF(D2="M", COUNTIF($D$2:D2,"M"), COUNTIF($D$2:D2,"F")) طبعاً ، وسنسحب المعادلة الى آآآخر خلية للتنفيذ عليها . ولا مشكلة لو تم اخفائها على سبيل المثال . الآن في العمود C والخلية C2 نستخدم هذه المعادلة :- =IF(D2="M", "قاعة " & CEILING(E2/$I$5,1), "قاعة " & CEILING(E2/$J$5,1)) الثاني من خلال الماكرو التالي :- Sub DistributeStudentsToRooms() Dim ws As Worksheet Dim lastRow As Long, i As Long Dim totalRooms As Integer, malesPerRoom As Integer, femalesPerRoom As Integer Dim maleCount As Integer, femaleCount As Integer Dim roomAssignment As Integer Dim roomCounters() As Integer Dim gender As String Set ws = ThisWorkbook.Sheets("ورقة1") totalRooms = ws.Range("H5").Value malesPerRoom = ws.Range("I5").Value femalesPerRoom = ws.Range("J5").Value ReDim roomCounters(1 To totalRooms, 1 To 2) lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ws.Range("C2:C" & lastRow).ClearContents For i = 2 To lastRow gender = ws.Cells(i, "D").Value For roomAssignment = 1 To totalRooms If gender = "M" Then If roomCounters(roomAssignment, 1) < malesPerRoom Then roomCounters(roomAssignment, 1) = roomCounters(roomAssignment, 1) + 1 Exit For End If Else If roomCounters(roomAssignment, 2) < femalesPerRoom Then roomCounters(roomAssignment, 2) = roomCounters(roomAssignment, 2) + 1 Exit For End If End If If roomAssignment = totalRooms Then roomAssignment = 0 Next roomAssignment ws.Cells(i, "C").Value = "قاعة " & roomAssignment Next i MsgBox "تم توزيع الطلاب على القاعات بنجاح", vbInformation + vbMsgBoxRight, "" End Sub وهذا ملف مرفق للطريقتين :- Desktop.zip
  5. مشاركة مع معلمي الفاضل .. جرب هذا الاستعلام :- SELECT m.*, i.*, (SELECT COUNT(*) FROM info_stagiere i2 LEFT JOIN modul m2 ON i2.ID = m2.id WHERE i2.annee = i.annee AND i2.grade = i.grade AND i2.wilaya = i.wilaya AND (m2.mouadel_3am > m.mouadel_3am OR (m2.mouadel_3am = m.mouadel_3am AND i2.ID <= i.ID))) AS myoutonum FROM info_stagiere i LEFT JOIN modul m ON i.ID = m.id WHERE i.annee = [Forms]![frm_examen_fin_formation]![annet] AND i.grade = [Forms]![frm_examen_fin_formation]![grade1] AND i.wilaya = [Forms]![frm_examen_fin_formation]![wilaya1] ORDER BY m.mouadel_3am DESC, i.ID ASC;
  6. والخبر الجيد بحكم تجربتي مع استيراد بيانات من جوجل شيت الى جداول اكسيس نعم ، يمكنك تحويل الملف إلى Google Sheets واستبدال أكواد VBA بـ Google Apps Script (لغة برمجة مختلفة) طبعاً للوهلة الأولى هذا غير ممكن بشكل مباشر ، لكن يمكنك استخدام Google Apps Script كما أخبرتك لإنشاء وظائف مماثلة في Google Sheets وطبعاً مستقبلاً سأحاول ادراج موضوع بهذا الخصوص ( لضيق الوقت 😇 )
  7. وعليكم السلام ورحمة الله وبركاته .. بالنسبة للسطرين التاليين :- سيتم الذهاب الى المجلد Backup ، طبعاً بغض النظر عن وجود المجلد أو لا ( أي أنه لا يتم التحقق من وجود المجلد قبل فتحه ) .. ثم لاحظت انك انتقلت الى المجلد :- فما الهدف !!!!! إلا إذا كان مقصدك ان المجلد السابق موجود داخل المجلد Backup هنا يجب ان تكون الجملة :- cd D:\BACKUP$\periodic أيضاً لاحظ أن عبارة :- لإنشاء مجلد بالتاريخ والوقت الحالي قد يلحقك بمشكلة إذا كانت الساعة أقل من 10 ، وهذا مثال على نتيجة السطر :- 20_5-_-07-12_ 1_46_01.3 لاحظ أن الساعة 1:47 لكن دقق في النتيجة لإسم المجلد يوجد فراغ قبل الرقم 1 . بالعموم ، فكرتك جميلة وقابلة للتطوير اذا اجتهدت عليها أكثر . فشكراً لك على هذه المشاركة الجميلة لفكرة نسخ إحتياطي لقاعدة البيانات من مجلد رئيسي بمجلداته الفرعية مع ضبط بعض الخصائص ..
  8. اسمح لي بمداخلة أخي جو .. الآن عند فتح التقرير والرسالة أمامه ، فلن يسعك رؤية التقرير ( إن كان صفحة أو أكثر .. ) لأسباب متعددة ، منها أن التقرير في وضع المعاينة سيكون ذا خط صغير ولن تستطيع تحريك أشرطة التمرير أو تكبير صفحة التقرير - Zoom - لرؤيته بشكل واضح ، صحيح ؟؟ إذا فإن عرض التقرير أو عدمه لن يغنيك بشيء. لذا ومن باب المنطق إما أن تجعل زر الطباعة داخل التقرير ، وبهذا ستتمكن من رؤيته كاملاً وتفحصه . أو رسالة الطباعة دون الإستناد لشرط عرض التقرير ( قد يكون مفتوحاً بوضع الإخفاء مثلاً .. ) هذه وجهة نظري الغير ملزمة طبعاً 😇
  9. أستاذنا الحبيب أبو أحمد 💐 وفقكم الله في الدارين وغفر لكم .. شكراً على التهنئه 🤗
  10. أخي طاهر ،، بارك الله فيك ، وغفر لك ولوالديك في الدنيا والآخرة. كلامك اللطيف دلالة على معدنك الطيب 🤗 شكراً لك من القلب على تهنئتك ، وأتمنى أن نراكم قريباً بجانبنا 💐
  11. كلامك صحيح .. لم أقم بالتجربة على أرقام مختلفة .. في مديول :- Function MultiplyTime(ByVal tm As Date, ByVal factor As Long) As String Dim totalMinutes As Long totalMinutes = DateDiff("n", #12:00:00 AM#, tm) * factor MultiplyTime = Format(totalMinutes \ 60 & ":" & totalMinutes Mod 60, "hh:nn") End Function جرب على الإستدعاء من خلال الاستعلام :- SELECT MultiplyTime(#4:30#, 10) AS النتيجة
  12. وعليكم السلام ورحمة الله وبركاته .. كمثال خطر ببالي من داخل استعلام على سبيل المثال :- SELECT Format(TimeValue("4:30") * 5, "hh:nn") AS النتيجة; أو استخدام الدالة CLng كمثال :- SELECT Format((CLng(#12/30/1899 4:30:0#*1440)*5)/1440,"Short Time") AS الناتج;
  13. وعليكم السلام ورحمة الله وبركاته .. أخي الفاضل تحية طيبة وعطرة من القلب ,, برأيك ( العنوان و المطلوب ) = من كلمتين يكفي للشرح والتوضيح للمطلوب ؟؟؟؟؟ حتى أن المرفق لا يستند الى أي معلومة تفيد المطلوب وتوضحه راجياً منك الإفصاح والتوضيح في معطيات الموضوع لتسهيل فهم للهدف ( وخصوصاً أخوك صاحب هذا التعليق 😇 )
  14. حفاظاً على محتوى الموضوع الجميل ، تم فتح موضوع منفصل للمشكلة التي صادفت أخونا @jo_2010 ، في هذا الرابط :-
  15. تفضل أخي الكريم .. تعديلات وإضافة مرونة أكثر للإستخدام وتقليل التكرارات . في الدالة الرئيسية :- Public Function GetTxtHeight(annee As String, grade As String, wilaya As String, nomRapport As String) As Single Dim db As DAO.Database Dim rs As DAO.Recordset Dim hauteur As Single Set db = CurrentDb Set rs = db.OpenRecordset( _ "SELECT hauteur_rang FROM tab_hauteur_range " & _ "WHERE annee = '" & Replace(Trim(annee), "'", "''") & "' " & _ "AND grade = '" & Replace(Trim(grade), "'", "''") & "' " & _ "AND wilaya = '" & Replace(Trim(wilaya), "'", "''") & "' " & _ "AND nom_raport = '" & Replace(Trim(nomRapport), "'", "''") & "'", dbOpenSnapshot) If Not rs.EOF Then hauteur = Nz(rs!hauteur_rang, 0) * 567 Else hauteur = 0.7 * 567 End If rs.Close: Set rs = Nothing: Set db = Nothing GetTxtHeight = hauteur End Function دالة لتقليل تكرار عند فتح التقرير ، وإضافة مرونة في Tag مختلف من نفس الاستدعاء .. Public Sub ApplyHeightFromTempVars(ByVal rpt As Report, Optional ByVal tagMatch As String = "moho58") On Error GoTo SafeExit Dim h As Single Dim ctrl As Control h = Nz(TempVars!Temp_Hauteur, 0.7 * 567) For Each ctrl In rpt.Controls If ctrl.ControlType = acTextBox Then If LCase(Trim(Nz(ctrl.Tag, ""))) = LCase(tagMatch) Then ctrl.Height = h End If End If Next ctrl rpt.Section(acDetail).Height = h SafeExit: End Sub في أحدث عند النقر للأزرار :- Private Sub أمر2_Click() Dim h As Single h = GetTxtHeight(Me.annet, Me.grade1, Me.wilaya1, "rap_pv") TempVars!Temp_Hauteur = h DoCmd.OpenReport "rap_pv", acViewPreview End Sub Private Sub أمر3_Click() Dim h As Single h = GetTxtHeight(Me.annet, Me.grade1, Me.wilaya1, "rap_pv2") TempVars!Temp_Hauteur = h DoCmd.OpenReport "rap_pv2", acViewPreview End Sub في حدث عند الفتح في التقارير :- Private Sub Report_Open(Cancel As Integer) ApplyHeightFromTempVars Me ' ApplyHeightFromTempVars Me, "Foksh" تستطيع طبعاً استخدام تاج مختلف End Sub ملفك بعد التعديلات :- baseM5.zip
  16. ولا يهمك ،، استكمالاً للسابق سأقوم بالتعديل، وإرقاق النتيجة بعد التجربة على أرض الواقع إن شاء الله 😇
  17. أخي العزيز الأستاذ عبد اللطيف ، بداية هذه الرسالة تظهر وأعتقد لأنه يوجد لديك تطبيق واتس أب سطح المكتب .. حيث ، انظر لهذا السطر على سبيل المثال :- https://api.whatsapp.com/send/?phone=962787787573&text&type=phone_number&app_absent=0 لاحظ الرقم 0 في نهاية العنوان !! انظر لطبيعة ونوع الرسالة التي تظهر لك عندما يكون لديك تطبيق واتس اب سطح المكتب . ثم جرب وعدل 0 = 1 ، وانظر الفرق بين الرسالتين !!!! طبعاً في النهاية سيتم فتح التطبيق في حال تم تثبيته لأن له الأولوية على موقع الويب . لكن في نهاية المطاف ، لتجربة أن الكود يقوم فعلاً بتنفيذ المطلوب ، قم بحذف تطبيق الواتس اب لديك من الكمبيوتر ، وجربه ولاحظت أيضاً انه عندما لا يكون هناك ايميل ، فيظهر لك خطأ .. قم بإضافة هذا السطر في بداية حدث النقر لمربع النص الخاص بإرسال الإيميل Private Sub EMAIL_Click() If IsNull(Me.EMAIL) Or Me.EMAIL = "" Then Exit Sub
  18. وعليكم السلام ورحمة الله وبركاته ,, فيما يخص الإيميل ، فهذه فكرة بسيطة من خلال النقر على مربع نص الإيميل على سبيل المثال :- Private Sub EMAIL_Click() Dim EmailAdd As String Dim GmailURL As String EmailAdd = Me.EMAIL.Value If Not IsValidEmails(EmailAdd) Then MsgBox "عنوان البريد الإلكتروني غير صالح", vbExclamation + vbMsgBoxRight, "" Exit Sub End If GmailURL = "https://mail.google.com/mail/?view=cm&fs=1&to=" & EmailAdd Application.FollowHyperlink GmailURL End Sub Function IsValidEmails(EMAIL As String) As Boolean Dim regex As Object Set regex = CreateObject("VBScript.RegExp") regex.Pattern = "^[\w-\.]+@([\w-]+\.)+[\w-]{2,4}$" regex.IgnoreCase = True IsValidEmails = regex.Test(EMAIL) End Function والطلب الثاني ، وهو فتح واتس أب ويب على دردشة محددة للرقم الذي تم النقر عليه ، حذح محاولتي البسيطة ( مشتقة من أحد ملفاتي سابقاً ) .. Private Sub MOB_Click() Dim WhatsURL As String Dim PhoneNum As String PhoneNum = Me.MOB.Value PhoneNum = CleanPhoneNum(PhoneNum) If PhoneNum = "" Then MsgBox "رقم الهاتف غير صالح", vbExclamation + vbMsgBoxRight, "" Exit Sub End If WhatsURL = "https://wa.me/" & PhoneNum Application.FollowHyperlink WhatsURL End Sub Function CleanPhoneNum(phone As String) As String Dim i As Integer Dim result As String result = "" For i = 1 To Len(phone) If IsNumeric(Mid(phone, i, 1)) Then result = result & Mid(phone, i, 1) End If Next i If Left(result, 2) = "00" Then result = Right(result, Len(result) - 2) ElseIf Left(phone, 1) = "+" Then result = Right(result, Len(result) - 1) End If CleanPhoneNum = result End Function
  19. جزاكم الله كل خير على تهنئتكم الكريمة ، وأسأل الله لكم مزيداً من التوفيق والنجاح 💐
  20. المبدعون هم أمثالكم في لطفهم ومرورهم ،، جزاكم الله كل الخير على دعواتكم ، وأسأل الله لكم التوفيق والنجاح 💐
  21. أخي الكريم وعليكم السلام ورحمة الله وبركاته 🤗 وبما أن المشروع ليس من تأسيسك ، فأعتقد انك بحاجة الى إعادة بناء المشروع ، وليس كما تظن 3 طلبات فقط. لذا .. أنصحك بالتوجه الى عرض طلباتك واحداً واحداً في مواضيع مستقلة ، مع الشرح الكافي مصحوباً بملف يحتوي سجلات بسيطة . ملاحظة:- لم أطلع على الملف .
  22. وعليكم السلام ورحمة الله وبركاته 🤗 باعتقادي ، وبما أنك تجعل اسم الوثيقة هو رقم ، فهنا يجب أن تجعل اسم الوثيقة مربوطاً أيضاً برقم الموظف ( الأفضل ) ، أو اسم الموظف على سبيل المثال . هنا الوثيقة 1 للموظف1 ستختلف في الاسم عن الوثيقة 1 للموظف2 ، صحيح 😁 . لم أطلع على الملف ، أتابع من الهاتف حالياً.
  23. أهلاً يا فنان .. وحشتني يا راجل ، طمني عنك عامل إيه 🤗 .. الله يبارك فيك على كلامك اللطيف الجميل 😇😇
×
×
  • اضف...

Important Information