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

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا الحل ربما يناسبك Sub CopyRanges() Dim i As Long, a As Long, lr As Long Dim OneRng As Variant, arr As Variant, Irow As Long, C As Long Dim oldData() As Variant, newData() As Variant Dim xlnCalcMethod As XlCalculation Dim WS As Worksheet: Set WS = Sheets("نتيجةت4") Dim f As Worksheet: Set f = Sheets("نتيجة تقييم41") Irow = f.Cells.SpecialCells(xlCellTypeLastCell).Row oldData = Array("غ", "ازرق", "اخضر", "اصفر", "احمر") newData = Array("لم يتقن المعارف", "يفوق التوقعات", "امتلك المعارف والمهارات", "يحتاج لبعض الدعم", "لم يتقن المعارف") a = WS.Columns("E:AE").Find(What:="*", _ SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row With Application xlnCalcMethod = .Calculation .Calculation = xlCalculationManual .EnableEvents = False .ScreenUpdating = False f.Range("E11:R" & f.Rows.Count).ClearContents OneRng = Array("F13:F" & a, "H13:H" & a, "J13:J" & a, "l13:l" & a, "N13:N" & a, "P13:P" & a, _ "R13:R" & a, "U13:U" & a, "W13:W" & a, "Y13:Y" & a, "AA13:AA" & a, "AC13:AC" & a, "AE13:AE" & a) arr = Array("E11", "F11", "G11", "H11", "I11", "J11", "K11", "L11", "M11", "N11", "O11", "P11", "Q11") For i = 0 To UBound(OneRng) WS.Range(OneRng(i)).Copy f.Range(arr(i)).PasteSpecial xlPasteValues Application.CutCopyMode = False Next lr = f.Columns("E:Q").Find(What:="*", _ SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row Set Rng = f.Range("E11:Q" & lr) For C = LBound(oldData) To UBound(oldData) Rng.Replace oldData(C), newData(C), xlWhole, , , , False, False Next With f.Range("R11:R" & lr) .Formula = "=IF(" & WS.Name & "!F13="""",""""," & WS.Name & "!AF13)" .Value = .Value End With .Calculation = xlnCalcMethod .EnableEvents = True .ScreenUpdating = True End With End Sub تحويل الى كود V2.xlsm

تفاديا للاخطاء لا تنسى تغديل السطر الخاص بافراغ البيانات السابقة الى f.Range("D11:R" & f.Rows.Count).ClearContents

شكرا اخى الكريم مبدع بدرجة فنان بارك الله فيك وزادكم

يسعدنا اننا استطعنا مساعدتك

اخي الكريم المسالة سهلة يكفي تحديد العمود المرغوب نسخ بياناته في السطر الاول مع تحديد خلية بداية اللصق في السطر الثاني ' Sheets("نتيجةت4")اسماء الاعمدة المرغوب ترحيلها OneRng = Array("F13:F" & a, "H13:H" & a, "J13:J" & a, "l13:l" & a, "N13:N" & a, "P13:P" & a, _ "R13:R" & a, "U13:U" & a, "W13:W" & a, "Y13:Y" & a, "AA13:AA" & a, "AC13:AC" & a, "AE13:AE" & a, _ "A13:A" & a) '<=======عمود المسلسل======== ' خلية اللصق Sheets("نتيجة تقييم41") arr = Array("E11", "F11", "G11", "H11", "I11", "J11", "K11", "L11", "M11", "N11", "O11", "P11", "Q11", _ "D11")'<=====اول خلية على عمود تاريخ الميلاد======== تحويل الى كود V3.xlsm

يمكنك اظافة اسم ورقة العمل داخل الكود بهدا الشكل Private Sub CommandButton1_Click() Dim sh As Worksheet Set sh = Sheets("Sheet1") Sum = Evaluate("=SUMIFS(" & sh.Name & "!F3:F100000," & _ sh.Name & "!B3:B100000,"">=""&" & sh.Name & "!I2,B3:B100000,""<=""&" & sh.Name & "!j2)") Me.TextBox1.Value = Format(Sum, "#,##0.0") End Sub او الاعتماد على مربع Combobox لاختيار ورقة العمل المرغوب تنفيد الكود عليها Private Sub UserForm_Initialize() For Each s In ActiveWorkbook.Sheets Me.ComboBox1.AddItem s.Name Next s End Sub '******************** Private Sub CommandButton1_Click() If Me.ComboBox1 <> "" Then X = Me.ComboBox1.Value Set n = ThisWorkbook.Sheets(X) Sum = Evaluate("=SUMIFS(" & n.Name & "!F3:F100000," & n.Name & "!B3:B100000,"">=""&" & n.Name & _ "!I2,B3:B100000,""<=""&" & n.Name & "!j2)") Me.TextBox1.Value = Format(Sum, "#,##0.0") End If End Sub sumif v2.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته تفضل اخي الكريم Option Explicit Sub Découpe_45() Dim WS As Worksheet, WS2 As Worksheet Dim i As Long, j As Long, k As Long, x As Long Dim Cpt As Long, r As Long, headers As Range Set WS = ThisWorkbook.Sheets("ورقة1"): Set WS2 = ThisWorkbook.Sheets("ورقة3") Application.ScreenUpdating = False With WS2.Range("A4:F" & WS2.Rows.Count) .Cells.ClearFormats: .Cells.ClearContents End With j = 5: Cpt = 45: Set headers = WS.[A4:F4] k = WS.Range("A:F").Find("*", SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row For i = j To k Step Cpt If i = j Then headers.Copy Destination:=WS2.[A4] WS.Range("A" & i & ":F" & i + Cpt - 1).Copy Destination:=WS2.Range("A" & j) Else x = WS2.Range("A:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 7 headers.Copy Destination:=WS2.Range("A" & x) WS.Range("A" & i & ":F" & i + Cpt - 1).Copy Destination:=WS2.Range("A" & x + 1) End If Next i For r = 1 To 6 WS2.Cells.EntireRow.AutoFit WS2.Columns(r).ColumnWidth = WS.Columns(r).ColumnWidth Application.ErrorCheckingOptions.NumberAsText = False Next Application.ScreenUpdating = True End Sub جدول 2024.xlsb

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا Private Sub CommandButton1_Click() Sum = Evaluate("=SUMIFS(F3:F100000,B3:B100000,"">=""&I2,B3:B100000,""<=""&j2)") Me.TextBox1.Value = Format(Sum, "#,##0.0") End Sub sumif.xlsm

لا .. لا دخل للعلاقات وانما الفرق في طريقة عمليات التصفية في الاستعلامات سارفق تعديلا حسب فكرتك

مشاركة مع استاذي ومعلمي @jjafferr تفضل المرفق حسب مافهمت . MacroClose rpt_Form.rar

تفضل يا سيدي اعمل اغلق النموذج/التقرير اولا (لاحظ مافيه اسم النموذج) ، ثم افتح النموذج الآخر لاحقا . لماذا ؟ شوف المقطع التالي: . جعفر

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

لو في بداية محرر الاكواد السطر 2 يوجد (Option Explicit) هذة للمطالبة بتعريف المتغيرات . الغيها وكل شئ بيصير تمام. اما (me. Default selected item) لو حبيت ترجع وتغير اختيارك - بيرجع محتوى الكومبوبكس لاصله . أما غير ذلك انت محتاج لتحديث الأوفيس لديك (ازالة واعادة تنصيب) .

جرب تقلب الكود ، كالتالي DoCmd.Close acForm, Me.Name DoCmd.OpenForm "main" وأريد اضافة الكود لإغلاق التقرير المفتوح DoCmd.Close report, Me.Name DoCmd.OpenForm "main" . او خلينا نشوف اللي عملته ، نشوف وين الخطأ

عندك الكود ، واعمل هذا التغيير : بدل Me.Results.BackColor = RGB(0, 255, 0) 'green اكتب Me.Results = "اخضر" . وهكذا مع بقية الشروط

وعليكم السلام 🙂 قاعدة ذهبية: لا تبدأ اسماء الكائنات او الحقول بأرقام. اسم حقل التاريخ اصبح iDate ، واسم حقل النتائج اصبح Results . انا عملت تغيير في خلفية الحقل Results على اسا قيمة iDate : Private Sub Form_Current() Call iDate_AfterUpdate End Sub Private Sub iDate_AfterUpdate() 'send the date properly Call Check_Dates(DateSerial(Year(Me.iDate), Month(Me.iDate), Day(Me.iDate))) End Sub Function Check_Dates(D As Date) 'Debug.Print DateSerial(Year(D), Month(D), Day(D)) If (Day(D) >= 1 And Month(D) >= 1) And (Day(D) <= 31 And Month(D) <= 3) Then Me.Results.BackColor = RGB(0, 255, 0) 'green ElseIf (Day(D) >= 1 And Month(D) >= 4) And (Day(D) <= 30 And Month(D) <= 6) Then Me.Results.BackColor = RGB(0, 0, 255) 'blue ElseIf (Day(D) >= 1 And Month(D) >= 7) And (Day(D) <= 30 And Month(D) <= 9) Then Me.Results.BackColor = RGB(255, 0, 0) 'red ElseIf (Day(D) >= 1 And Month(D) >= 10) And (Day(D) <= 31 And Month(D) <= 12) Then Me.Results.BackColor = RGB(0, 0, 0) 'black End If End Sub . جعفر

الشرف لينا اخى الكريم الكلام مش هيوفي حقك والله

شكرا اخى الكريم تصحيح.xlsm

اخي الفاضل 🙂 هل حاولت عمل ماكرو ؟ في الواقع اللي انت تريده يمكن لأي هاوي عمله ، فشد حيلك وحاول ، واحنا نساعدك لما تحصل على صعوبة 🙂 جعفر

اشوفك بدأت تعرف السر

تم التعديل : 1- اظهار الوحدة في التقرير 2- بالنسبة للبحث يمكنك الآن البحث بحرف او اثنين شامل جميع الحقول 3- للتعديل انقر نقرا مزدوجا على رقم الحركة سيظهر لك بيانات الحركة في مذكرة خاصة بالتعديل _________________________________________________ هذا الطلب غير منطقي لان كل مخزن له مذكراته الخاصة به في الادخال والاخراج اذا كان تصدير المذكرات عام ويتم بعد ذلك توجيه السلع الى المخازن حسب الصنف .. فنحن بحاجة الى اعادة التصميم ، او بالاصح التعديل على التصميم stock8.rar

شكرا خالص اخي @محمد هشام. بس تعديل على الكود عايز انسخ كمان بيانات من مسلسل الى تاريخ الميلاد من نتيجةت4 الى نتيجة تقييم41

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

اشكرك أستاذى الكبير @jjafferr على مشاركتك وردك الذى استفدت منه كثير . ولكن خاننى التعبير فى كلمة تبويب والمطلوب هو ما نفذه استاذى @kkhalifa1960 اشكركم جميعا على دعمك لأعضاء هذا المنتدى العظيم وجعل علمكم فى ميزان حسناتكم

استاذ @Zooro1' طالع المرفق . Combo_2.rar

طريقة اخرى لتحقيق المطلوب يوجد حقلان ... اكتب في الاول اسما مثل محمد علي ثم انتر لتنتقل للحقل الآخر لو ابتدأت بحرف الميم سوف يظهر لك الاسم كاملا اما غير حرف الميم فلن يظهر لك شيئا Dim i, ii As String Private Sub Text0_AfterUpdate() i = Text0.Value End Sub Private Sub Text2_KeyUp(KeyCode As Integer, Shift As Integer) ii = Left(i, 1) If Text2.Text = ii Then Text2 = i End Sub db1.accdb

اولا: . ثم يفتح لك هذا النموذج ، 1. اكتب اسم الحقل (الكلمة التي تريد البحث عنها) الذي تريد ان تبحث عنه في جميع كائنات البرنامج ، حسب ما تم التأشير عليه من جداول واستعلامات وتقارير ونماذج وكود ، 4. انقر البحث ، فيعطيك قائمة بكل كائن فيه هذه الكلمة (تنقر مرتين فيفتح لك الكائن ، وتقدر تغير الكلمة يدويا) ، وبعد ان تطمئن انه لا يوجد خلط وكل شيء واضح ، يمكنك النقر على رقم 2 وتكتب كلمة التغيير/الاستبدال التلقائي لهذه الكلمة في جميع الكائنات.

وعليكم السلام 🙂 اما انا فلم افلح مع الذكاء الصناعي !! ما ادري ، يمكن اسألتي صعبة 😁 الخطأ يقول: اول قيمة في الدالة ، نوع المتغير studentID في الدالة IsTeacherAssigned هو Integer . بينما بدلا عن تدخل قيمة Integer ، انت ادخلت قيمة من نوع: . الخطأ في السطر: . سهله 🙂 جعفر

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

هو غباء وليس ذكاء مطلقا انا عن نفسى كانت تجربتى معه سيئة جدا جدا جدا