كل الانشطه

كان عندي برنامج شغال شبكة علي اكثر من جهاز ولاكن عند تحديث وندوز لاحد الاجهزة - اصبح البرنامج غير شغال على هذا الجهاز جميع الازرار معطله - علماً بأنها مرتبطه بكود برمجه ما السبب - ايه هي الحاجات اللي ممكن ابص عليها او اغيرها في الوندوز او البرنامج - علشان اشغله تاني شكراً

وعليكم السلام ورحمة الله وبركاته .. تفضل هذه الفكرة :- Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range, valToCheck, foundCell As Range On Error Resume Next Set c = Intersect(Target, Columns("E")) If c Is Nothing Then Exit Sub Application.EnableEvents = False valToCheck = c.Value If valToCheck <> "" Then Set foundCell = Columns("E").Find(valToCheck, LookIn:=xlValues) If Not foundCell Is Nothing And foundCell.Row <> c.Row Then If WorksheetFunction.CountBlank(Range("K" & foundCell.Row & ":N" & foundCell.Row)) = 4 Then MsgBox "الحالة سبق ادخالها ولم يتم بشانها اجراء", vbExclamation + vbMsgBoxRight, "تنبيه" c.ClearContents End If End If End If Application.EnableEvents = True End Sub Book1.zip

السلام عليكم فى الملف المرفق يتم كتابة رقم الحالة فى العمود E المطلوب: عند ادخال رقم الحالة وهذه الحالة سبق ادخالها يتم التاكد من اتخاذ اجراء فيها من خلال الاعمدة K & L &M & N بمعنى على سبيل المثال اذا كانت الخانات امام الادخال الاول فى هذه الاعمدة ممتلئة فيقبل كتابة الحالة اما إذا كانت فارغة فلا يقبل وتظهر رسالة انه سبق الادخال ولم يتخذ اجراء مع العلم انه ممكن الحالة تكتب اكثر من 10 مرات طالما اتخذ فيها اجراء فلا مشكلة من الادخال مرة اخرى تقبلوا تحياتى واحترامى Book1.rar

السلام عليكم ولكن نصيحة انصحكم بها ويندوز 10 سوف يتم ايقاف الدعم عنه فى اكتوبر القادم من اجل ذلك التحديث تم الى ويندوز 11 بشكل صارم وسوف يأتى عليه وقت وكما هو الحال مع ويندوز 7 الان لن تجد المتصفحات مدعومة ولا بعض البرامج فى المستقبل مع ويندوز 10 كما هو الحال الان مع ويندوز 7 و ويندوز XP

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

وهذا من احد الأسباب التي دفعتني لعمل هذه السلسلة بالتوفيق إن شاء الله

الفكرة ليست في إيجاد بدائل فقط ، الفكرة في إيجاد بدائل دائمة وليس مؤقته ..

هل هناك بدائل أخرى تعمل بنفس الفكرة

استاذي الكريم @منتصر الانسي اشكرك على هذا العمل الرائع وبعد الاطلاع على الكود ما شاء الله ابداع ومجهود كبير خلاني افكر فى افكار اخري 😅 الف شكر

شكرا استاذ @Foksh الاجابة قبل الاخيرة صحيحة

السلام عليكم اقترح عليكم التعديل التالي: يكون البرنامج وظيفته 1- رفع الفاتورة الالكترونية الي موقع الهيئة 2- تنزيل الفواتير السابقة التي تم عملها 3-عمل اشعار خصم 4-......... و هذكا

انا بقي بعد اكثر من سنه ونصف او اكثر شوي على وندوز 11 رجعت ل 10 علشان وحشني 😁 (وعلشان حسيت وندوز 11 بدأ يتغابي معايا ولقيت نفسي باعاني معاه فقولت الطلاق افضل ورجعت لام عيالى وندوز 10) ^_^

استاذ @سلمان الشهراني حفظك الله ممكن ترسلي رقم المهندس انا اريد انا اربط ايضأ

شكرا جزيلا أخي الفاضل وبارك الله فيك وأكثر الله من أمثالك

فقط يلزمك تغيير السطر التالي :- .Fields.Append .CreateField("lejnah_id", dbText) الى التعديل التالي :- .Fields.Append .CreateField("lejnah_id", dbLong) للتعامل مع الحقل على انه رقمي بدلاً من نصي .. وسيكون التسلسل كرقم وليس كنص وبالتالي تحصل على طلبك 😇

شكرا جزيلا أخي الفاضل علي كرمك وسعة صدرك ممكن نضبط لجنة 10 تنزل اسفل لجنة 9 أو لو فيه طريقة أخري اسهل نصمم بها هذا النموذج والتقرير أمشي مع حضرتك خطوة خطوة لأن هذه الطريقة ساعدني بها استاذنا ومعلمنا ( أبو خليل ) أدام الله في عمره وزاده الله من علمه وكانت علي رغبتي رغم أنه لم يقتنع بها

رغم أن طريقتك في التصميم غريبة 😅 ، وتحتاج وقتاً لاستيعابها ، لكن تفضل ، جرب هذا التعديل : Data127.zip

ملحوظة أخري يوجد repTawzeeSub لا يعمل في التقرير molahza المفروض يظهر هكذا

شكرا جزيلا لسرعة الاستجابة فيه ملحوظتين : أولا : عند اختيار فرقة واحدة من النموذج مثلا الصف الثالث والضغط علي التقرير يأتي التقرير بالفرقتين ( الثالث والرابع ) محتاج عند اختيار فرقة واحدة يأتي التقرير بالفرقة الواحدة وعند اختيار الفرقتين يأتي التقرير بالفرقتين كما في الصورة ثانيا : في التقرير لماذا تأتي لجنة 10 أعلي التقرير مع أن المفروض تأتي بعد لجنة 9

هذا اعتمده رئيس احدى البلديات في احدى المناطق .... حتى يضمن تواجد الموظفين ....

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

وعليكم السلام ورحمة الله وبركاته ، بدلاً من الإستعلام المعقد الذي استخدمته ، كان لي فكرة أخرى وهي الإعتماد على جدول مؤقت .. تابع الخطوات التي شرحتها أعلاه ، وانقر زر "اختر التاريخ والصفوف او احدها ثم انقر" ، وتابع النتيجة إن كانت صحيحة ,, Data126.zip

إخواني الأعزاء بعد سلام الله عليكم ورحمة الله وبركاته في الملف المرفق Data126.rar جدول باسم tbl_Exams وجدول باسم tblTawzee ومربوطين بنموذج باسم frmTawzee وهوخاص بملاحظة المعلمين للجان وعند الضغط علي النموذج ( frmTawzee ) واختيار العام الدراسي ثم اختيار الفصل الدراسي ثم اختيار التاريخ والفترة والصف الدراسي سواء صف واحد أو اختار صفين ثم الضغط علي زر (اختر التاريخ والصفوف او احدها ثم انقر ) يجلب تقرير باسم ( molahza ) به جميع البيانات المشكلة عن الضغط علي زر (اختر التاريخ والصفوف او احدها ثم انقر ) لا يأتي بالبيانات وتظهر الرسالة الآتية ارجو الحل

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

لنجرب هذا مع إظافة الترتيب الأبجدي لعناصر الـكومبوبوكس عند النقر المزدوج يتم ترتيب القائمة تلقائيا قبل العرض Option Explicit Dim WS As Worksheet Dim OnRng As Variant Dim ColArr As Long Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set WS = Sheets("داتا") Dim f As Worksheet: Set f = Sheets("Sheet1") Dim lastRow As Long, cnt As Boolean, i As Long cnt = False lastRow = f.Cells(f.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRow If Trim(f.Cells(i, "A").Value) <> "" Then cnt = True Exit For End If Next i 'A' إظهار القوائم لغاية أخر صف يتضمن تاريخ على عمود' If cnt Then If Target.Count = 1 And Not Intersect(Target, Range("C2:O" & lastRow)) Is Nothing Then ' OR ' C2:O100 تحديد اخر صف لإظهار القوائم يدويا بما يناسبك ' If Target.Count = 1 And Not Intersect(Target, Range("C2:O100")) Is Nothing Then ColArr = Target.Column If xColumn(ColArr) Then On Error Resume Next OnRng = WS.Range(WS.Cells(2, ColArr), _ WS.Cells(WS.Rows.Count, ColArr).End(xlUp)).Value On Error GoTo 0 If Not IsEmpty(OnRng) Then If Not IsArray(OnRng) Then ReDim OnRng(1 To 1, 1 To 1) OnRng(1, 1) = WS.Cells(2, ColArr).Value End If Me.ComboBox1.List = Application.Transpose(OnRng) Else Me.ComboBox1.List = Array() End If With Me.ComboBox1 .Height = Target.Height + 3 .Width = Target.Width .Top = Target.Top .Left = Target.Left .Value = Target.Value .Visible = True .Activate End With Else Me.ComboBox1.Visible = False End If Else Me.ComboBox1.Visible = False End If Else Me.ComboBox1.Visible = False End If End Sub Private Sub ComboBox1_Change() Dim d1 As Object Dim tmp As String Dim i As Long Set d1 = CreateObject("Scripting.Dictionary") If Me.ComboBox1.Value = "" Then Me.ComboBox1.List = Application.Transpose(OnRng) Me.ComboBox1.DropDown Else tmp = UCase(Me.ComboBox1.Value) & "*" For i = 1 To UBound(OnRng, 1) If UCase(Trim(OnRng(i, 1))) Like tmp Then d1(Trim(OnRng(i, 1))) = "" End If Next i If d1.Count > 0 Then Me.ComboBox1.List = d1.Keys Me.ComboBox1.DropDown Else Me.ComboBox1.List = Array(Me.ComboBox1.Value) Me.ComboBox1.DropDown End If End If ActiveCell.Value = Me.ComboBox1.Value End Sub Private Sub ComboBox1_Click() Me.ComboBox1.List = Application.Transpose(OnRng) Me.ComboBox1.Activate Me.ComboBox1.DropDown End Sub Private Function xColumn(colNum As Long) As Boolean Select Case colNum Case 3, 4, 5, 9, 10, 11, 15 xColumn = True Case Else xColumn = False End Select End Function Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then ActiveCell.Offset(1).Select End Sub Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) On Error Resume Next Dim listArr() As String, i As Long If Not IsEmpty(OnRng) Then ReDim listArr(1 To UBound(OnRng, 1)) For i = 1 To UBound(OnRng, 1) listArr(i) = OnRng(i, 1) Next i Call filtre(listArr) Me.ComboBox1.List = listArr End If Me.ComboBox1.Value = "" Me.ComboBox1.Activate Me.ComboBox1.DropDown On Error GoTo 0 End Sub Private Sub filtre(arr() As String) Dim i As Long, j As Long, temp As String, n As Long n = UBound(arr) For i = 1 To n - 1 For j = i + 1 To n If StrComp(arr(i), arr(j), vbTextCompare) > 0 Then temp = arr(i): arr(i) = arr(j): arr(j) = temp End If Next j Next i End Sub تعديل 4 .xlsb