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

ومشاركة واثراء للموضوع ازيدكم من الشعر بيتا لماذا دائما نتجاهل استخدام دالة Switch و اول ما يشغل بالنا هو دائما دالة iif استخدام Switch انا احبه وافضله عن استخدام دالة iif يعدا قل تعقيدا واكثر سهولة فى الفهم ممكن استخدام الكود االتالى ' Sets rb to "normal" if Hb is between 10 and 16 (inclusive). ' Sets rb to "up" if Hb is greater than 16. ' Sets rb to "down" if Hb is less than 10. ' Sets rb to "" if Hb is blank. Me.rb = Switch( _ [Hb] >= 10 And [Hb] <= 16, "normal", _ [Hb] > 16, "up", _ [Hb] < 10, "down", _ [Hb] = "", "" _ ) طبعا انا قمت بكتابته على هذا النحو للتوضيح ممكن كتابته بالشكل التالى Me.rb = Switch([Hb] >= 10 And [Hb] <= 16, "normal", [Hb] > 16, "up", [Hb] < 10, "down", [Hb] = "", "")

Sub IFNotBlank() Dim lr&, i&, a() a = [A116:K231].Value lr = Range("AM" & Rows.Count).End(xlUp).Row Dim tmp(): ReDim tmp(1 To UBound(a)) For i = LBound(a) To UBound(a) If a(i, 1) > 0 Then n = n + 1: tmp(n) = i Next ReDim Preserve tmp(1 To n) a = Application.Index(a, Application.Transpose(tmp), _ Application.Transpose(Evaluate("Row(2:" & UBound(a, 2) & ")"))) Range("AM" & lr + 1).Resize(UBound(a), UBound(a, 2)) = a End Sub في حالة إظافة الصيغ على طول عمود (A) قم بتعديل الكود ليتم تجاهلها If a(i, 1) > 0 And _ a(i, 1) <> HasFormula Then n = n + 1: tmp(n) = i

السلام عليكم ورحمه الله وبركاته وبها نبدأ تفضل طباعة تقرير.xlsb

إليك الكود المعدل الذي سيسمح لك بإغلاق صفحات النموذج المحددة بدلاً من إغلاق جميع صفحات النماذج المفتوحة: Private Sub Form_Current() Dim FormCount As Integer Dim I As Integer Dim FormNamesToClose As Variant ' أضف أسماء صفحات النموذج التي تريد إغلاقها في هذه المصفوفة FormNamesToClose = Array("Form1", "Form2", "Form3") FormCount = Forms.Count For I = FormCount - 1 To 0 Step -1 If IsInArray(Forms(I).Name, FormNamesToClose) Then DoCmd.Close acForm, Forms(I).Name End If Next I End Sub Private Function IsInArray(ByVal stringToSearch As String, ByVal arr As Variant) As Boolean Dim i As Integer For i = LBound(arr) To UBound(arr) If arr(i) = stringToSearch Then IsInArray = True Exit Function End If Next i IsInArray = False End Function هنا كيف يعمل الكود المعدل: 1- مصفوفة FormNamesToClose تحتوي على أسماء صفحات النماذج التي تريد إغلاقها عند فتح النموذج الحالي. يمكنك إضافة أو إزالة أسماء النماذج من هذه المصفوفة حسب الحاجة. 2- دالة Form_Current() تقوم بالتمرير على جميع صفحات النماذج المفتوحة باستخدام خاصية Forms.Count. 3- لكل صفحة نموذج، يتحقق ما إذا كان اسم النموذج موجودًا في مصفوفة FormNamesToClose باستخدام دالة المساعدة IsInArray(). 4- إذا كان اسم النموذج موجودًا في مصفوفة FormNamesToClose، يتم استخدام بيان DoCmd.Close لإغلاق تلك صفحة النموذج. دالة IsInArray() هي دالة مساعدة تتحقق مما إذا كان السلسلة المعطاة موجودة في المصفوفة المقدمة. إنها تُرجع True إذا تم العثور على السلسلة، وFalse خلاف ذلك. بهذا الكود المعدل، يمكنك الآن تحديد صفحات النماذج التي تريد إغلاقها عند فتح النموذج الحالي، بدلاً من إغلاق جميع صفحات النماذج المفتوحة. ما يحتاج أخبرك من وين جبت الجواب

وعليكم السلام ورحمة الله تعالى وبركاته تفضل اخي @mahmoud nasr alhasany Private Sub CommandButton1_Click() Dim x() As Variant Set f = Sheets(1) x = Array("ListBox1", "ListBox2") Set d = CreateObject("Scripting.Dictionary") Set arr = f.Range("A2:C" & f.[A65000].End(xlUp).Row): a = arr.Value Dim tmp(): ReDim tmp(1 To UBound(a)) For i = LBound(a) To UBound(a) c = a(i, 3): Results = Array(a(i, 1), a(i, 2), a(i, 3)) If c > Date + 6 And c < (Date + 30) Then n = n + 1: tmp(n) = i ReDim Preserve tmp(1 To n + 1) Me.ListBox1.List = Application.Index(a, Application.Transpose(tmp), _ Application.Transpose(Evaluate("Row(1:" & UBound(a, 2) & ")"))) Me.ListBox1.RemoveItem n ElseIf c > 0 And c < (Date + 6) Then d(i) = Results End If Next n = d.Count If n > 0 Then Dim Cnt: Cnt = Application.Transpose(d.items) ReDim Preserve Cnt(1 To 3, 1 To n + 1) Me.ListBox2.List = Application.Transpose(Cnt) Me.ListBox2.RemoveItem n End If For i = 0 To UBound(x): Me.Controls(x(i)).ColumnCount = 3: Next i End Sub message for expiring items1 V2.xlsm

وعليكم السلام 🙂 طريقة بسيطة لعدة اوامر iif متداخلة : . جعفر

المشكلة عندك في اعدادات اللغة في وندوز المثال يعمل على اعدادات اللغة الانجليزية والعربية وجهازك اعتقد اللغة الافتراضية فيه هي الفرنسية

الف شكر لحضرتك

اليك طريقة متبعة غالبا عند تصميم قواعد البيانات 3.rar

اولا حاول وضع الكود في Module 2) النطاق ("Idate") غير موجود عندك على الملف ممكن تشرح لي ما تحاول فعله ؟

لديك اخطاء في تحديد اسماء الخلايا كما في الصورة المرفقة تم تعديل الكود ليسهل التعامل معه Private Sub CommandButton2_Click() 'بحث Dim WS As Worksheet, F As Worksheet Dim Irow As Long, Clé As String, i As Long Set WS = Sheets("Sheet2"): Set F = Sheets("Sheet1"): Clé = F.[E3] Application.ScreenUpdating = False If Clé = Empty Then: MsgBox "برجاء إدخال اسم للبحث عن بياناته", vbCritical, "فلاح": Exit Sub Irow = WS.Cells(WS.Rows.Count, "B").End(xlUp).Row Set rng = WS.Range("B3:B" & Irow).Find(Clé, LookIn:=xlValues, _ lookat:=xlWhole, SearchDirection:=xlPrevious) If rng Is Nothing Then: MsgBox " الاسم غير موجود", vbExclamation, Clé: Exit Sub For i = 3 To Irow If WS.Cells(i, 2) = Clé Then ' Colmun (D) F.[D5] = WS.Cells(i, "B") F.[D7] = WS.Cells(i, "C"): F.[D9] = WS.Cells(i, "D"): F.[D11] = WS.Cells(i, "E") F.[D13] = WS.Cells(i, "F"): F.[D15] = WS.Cells(i, "G"): F.[D17] = WS.Cells(i, "H") F.[D19] = WS.Cells(i, "I"): F.[D21] = WS.Cells(i, "J"): F.[D23] = WS.Cells(i, "K") ' Colmun (G) F.[G7] = WS.Cells(i, "L"): F.[G9] = WS.Cells(i, "M"): F.[G11] = WS.Cells(i, "N") F.[G13] = WS.Cells(i, "O"): F.[G15] = WS.Cells(i, "P"): F.[G17] = WS.Cells(i, "Q") F.[G19] = WS.Cells(i, "R"): F.[G21] = WS.Cells(i, "S"): F.[G23] = WS.Cells(i, "T") ' Colmun (J) F.[J7] = WS.Cells(i, "U") F.[J9] = WS.Cells(i, "V"): F.[J11] = WS.Cells(i, "W") F.[J13] = WS.Cells(i, "X"): F.[J15] = WS.Cells(i, "Y") End If Next Application.ScreenUpdating = True End Sub مع تعديل كود الترحيل بالشكل التالي Private Sub CommandButton1_Click() ' اظافة Dim WS As Worksheet: Dim F As Worksheet Set WS = Sheets("Sheet1"): Set F = Sheets("Sheet2") Application.ScreenUpdating = False F.Range("B" & F.Rows.Count).End(xlUp).Offset(1).Resize(, _ 24).Value = Application.Index(WS.Range _ ("D5,D7,D9,D11,D13,D15,D17,D19,D21,D23,G7,G9,G11,G13,G15,G17,G19,G21,G23,J7,J9,J11,J13,J15"), _ 1, 1, Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, _ 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26)) With F.Range("A3:A" & F.Cells(Rows.Count, "B").End(xlUp).Row) .Value = Evaluate("ROW(" & .Address & ")-2") End With Lr = F.Range("A65500").End(xlUp).Row b = F.Cells(2, F.Columns.Count).End(xlToLeft).Column F.Range(F.Cells(3, 1), F.Cells(Lr, b)).Borders.Weight = xlThin ' افراغ CommandButton4_Click Application.ScreenUpdating = True MsgBox "تم اضافة البيانات بنجاح" End Sub 123 (1).xlsm