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

احسنت استاذ محمد وهذا بالفعل ما كنت أود توضيحه جزاك الله كل خير وأكثر الله من أمثالك

من أساسيات التعامل مع vba عدم تسمية الدالة function بنفس اسم الموديول module يمكنك حل هذه المشكلة بإعادة تسمية الدوال أو اضافة اللاحقة _mod في نهاية اسم الموديول من خلال نافذة الخصائص أسفل يسار نافة محرر الأكواد بالتوفيق

اضافة لعزيزي استاذ حسام هذه استكمالا لطريقتك جمع حقول.accdb

تفضل التعديل ارجو ان يكون طلبك Nouveau Microsoft Access Database-1.rar

جرب المرفق مستحقات العاملين 3.xlsm

جرب هذا الكود لزر الترحيل فقط Private Sub CommandButton3_Click() Dim rng1 As Range Dim str_search As String str_search = Txt2.Value Set rng1 = sheets("SHEET1").Range("E:E").Find(str_search, , xlValues, xlWhole) If Not rng1 Is Nothing Then Application.ScreenUpdating = False Dim row_number As Long row_number = rng1.Row lastColumn = IIf(Sheets("SHEET1").Range("t" & row_number) = "", 20, Sheets("SHEET1").Range("t" & row_number).End(xlToRight).Column + 1) sheets("SHEET1").Cells(row_number, lastColumn).Value = Txt4.Value sheets("SHEET1").Cells(row_number, lastColumn + 1).Value = Txt7.Value sheets("SHEET1").Select Cells(row_number, lastColumn).Select Me.Hide Application.ScreenUpdating = True End If MsgBox "تم ترحيل المبلغ والتاريخ" End Sub بالتوفيق

السلام عليكم اساتذتى الكرام عندى سؤال .. هل يوجد طريقه لتشغيل ملف اكسل به اكواد على الهاتف ( الموبايل ) ؟؟وجزاكم الله خيرا

اضافة لما تفضل به استاذي @د.كاف يارفقد عملت لك نموذج بحث ويبقى عليك التنسيق me_Q.rar

تفضل هذا التعديل me.accdb

صيح يوجد خطأ هذا هو التعديل بناء على اكبر تاريخ DLast("[Per_Degree]";"[T1]";"[Per_Name] Like '" & [Per_Name] & "' AND [Ex_DATE] Like '" & DMax("[Ex_DATE]";"[T1]";"[Per_Name] Like '" & [Per_Name] & "'") & "'") Last_Degree.mdb

هذه تعطي اعلى درجة وليس اخر درجة

في الجدول T1 اخر درجة للطالبين هي 70 .... صحيح بادكتور حسين هل نبدلها بهذا .... Expr1: DMax("[Per_Degree]";"[T1]";"[Per_Name] Like '" & [T2]![Per_Name] & "'")

تفضل هذا التعديل قد يفي بالغرض Last_Degree.mdb

بارك الله فيكم تم الحل

كود التراجع عن آخر حركة واحدة قام بها المستخدم هو Application.undo وفي حالة التراجع عن أكثر من خطوة يفضل استعمال ctrl+z أو من شريط الوصول السريع QAT ******* أما إذا كان المقصود الرجوع إلى إصدار سابق من الملف قبل إجراء أية تعديلات فيمكن عن طريق تفعيل version history من تبويب file ثم info و رفع الملف في حساب OneDrive بالتوفيق

ياسلام عليك استاذ حسام هو ذا فعلا .... الظاهر الخطأ عندي ما اضفت Nz علما اني جربت تقريبا نفس الصيغه الف الف شكر 🤙

نعم صحيح قد لاحظتها في الحقل prix2 النتيجة 4000 وهي خاطئة النتيجة الصحيحة 2000 يعني انه الحقل قد جمع مرتين شكرا جزيلا الاستاذ حسام والاستاذ قاسم

شكرا جزيلا وجزاك الله خيرا

نقر مرتين على اليوزرفورم والصق هذا الكود لا ادري اذاكان هذا يفي بالغرض Private Sub UserForm_Activate() With Application Me.Top = .Top Me.Left = .Left Me.Height = .Height Me.Width = .Width End With End Sub

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

وعليكم السلام انت تريد تصدير التقرير من الاكسس الى الاكسل ... صحيح ... طيب فين ملف الاكسس حتى نجرب عليه ؟؟؟

تم إضافة الكود بنجاح بما كتبت حفظك الله + طريق تسجيل مكرو لما كتبتم

Sub ADDITEM() Dim x, itemRow As Long, availRow As Long With Sheet2 If .Range("K3").Value = Empty Then Exit Sub Application.EnableEvents = False itemRow = Range("K3").Value availRow = Range("F999").End(xlUp).Row + 1 Range("B4").Value = Sheet4.Range("B" & itemRow).Value Range("D5").Value = Sheet4.Range("D" & itemRow).Value Range("B5").Value = 1 Range("F" & availRow).Value = Range("B4").Value Range("G" & availRow).Value = Range("B5").Value Range("H" & availRow).Value = Range("D5").Value Range("I" & availRow).Value = "=H" & availRow & "*G" & availRow Application.EnableEvents = True End With End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim x, xx, RecptRow As Long If Not Intersect(Target, Range("B3")) Is Nothing And Range("B3").Value <> Empty Then xx = Application.Match(Range("B3"), Sheet4.Columns(1), 0) If Not IsError(xx) Then Range("B4").Value = Sheet4.Cells(xx, 2).Value x = Application.Match(Range("B4").Value, Columns(6), 0) If IsError(x) Then ADDITEM End If If Not Intersect(Target, Range("B5,D5")) Is Nothing And Range("K2").Value = False And Range("K1").Value <> Empty Then x = Application.Match(Range("B4").Value, Columns(6), 0) If IsError(x) Then RecptRow = IIf(Range("K5").Value = 0, Range("K1").Value, Range("K5").Value) Else RecptRow = x End If If Not Intersect(Target, Range("B5")) Is Nothing Then Range("G" & RecptRow).Value = Val(Range("G" & RecptRow).Value) + Target.Value If Not Intersect(Target, Range("D5")) Is Nothing Then Range("H" & RecptRow).Value = Val(Range("H" & RecptRow).Value) + Target.Value End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("f13:i999")) Is Nothing And Range("f" & Target.Row).Value <> Empty Then Range("K1").Value = Target.Row Range("K2").Value = True Range("b4").Value = Range("F" & Target.Row).Value Range("B5").Value = Range("G" & Target.Row).Value Range("D5").Value = Range("H" & Target.Row).Value Range("K2").Value = False End If End Sub

يمكن ربط تشغيل الكود بتغيير الخلية D3 خلية الفصل لا يؤثر ذلك على الكود وهذا كود حدث عند التغيير في شيت قائة فصل Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$3" Then Call mas_getdata4 End Sub يمكنك أن تبدأ من دورة vba الموجودة في أول موضوع مثبت في منتدى الاكسل (دليل المواضيع المثبتة) وفقنا الله جميعا لكل خير

يمكن استعمال المعادلة التالية في الخلية J17 من شيت المقسطون ='تسديد عميل'!C9 وهي لجلب قيمة عدد الأشهر المسددة مع وضع هذا الكود في حدث عند تغيير محتوى شيت المقسطون Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$3" Then Sheets("تسديد عميل").Range("b2").Value = Target.Value End Sub وهو يقوم بوضع رقم الملف المكتوب في شيت المقسطون في مكانه في شيت تسدسد عميل حتى يتم جلب الاشهر المسددة هناك أولا والمعادلة تجلبها هنا بالتوفيق

وفيكم بارك الله الرسم البياني للفرع كله فعلا اعتمادا على جدول البيانات المجاور للرسم البياني (الموظفين ونسب تحقيق الأهداف لجميع المنتجات) المتبقي يفهم من نسبة تحقيق الهدف مثلا المحقق 10٪ فالمتبقي 90٪ وإذا أضفتها سيتضاعف عدد الأعمدة 20 موظف ضرب 2 عمود ضرب 5 منتجات = 200 عمود (كثير جدا) لذا أنصح بعمود النسبة فقط والباقي هو ما يكمل المائة (معروفة) لا أدري ما المقصود بإجمالي المحقق للفرع كله؟ وإذا كنت تريد عملها فأعتقد في رسم بياني آخر مستقل تكون بياناته اجمالي المحقق للفروع كلها إجمالا او لكل منتج على حده بالتوفيق

المشكلة في هذا السطر في حدث بعد تحديث مربع النص Me.TextBox2 = Application.VLookup(Val(Me.TextBox1), Sheets("cod").Range("c5:e5000"), 2, 0) حيث يتم البحث حتى صف 5000 والرقم المطلوب في الصف 7152 لذلك يلزمك زيادة صف النهاية إلى 10000 مثلا

تفضل هذا ملفك بعد إضافة الكود وتعديل أسماء الشيتات من المسافات الزائدة وتعديل الأعمدة التي سيتم الترحيل لها حيث كان بها خلايا في الأسفل (مكتوب فيها) تمنع من دقة معرفة آخر صف مكتوب فيه بالتوفيق البرنامج 1-1.xlsm

بالاضافة الى ما تفضل به استاذنا الفاضل @د.كاف يار وله جزيل الشكر تفضل اخي الكريم جرب الكود التالي Dim strFolderPath As String Dim DB_Full_Name As String Dim DB_Name As String Dim Backup_Full_Name As String Dim Copy_File As Variant Dim DB_Directory As String strFolderPath = CurrentProject.Path & "\Backup\" ' التاكد من وجود مجلد Backup ' اذ لم يكن موجود يتم انشائه If Len(Dir(strFolderPath, vbDirectory)) = 0 Then MkDir strFolderPath End If ' تحديد قاعدة البيانات DB_Full_Name = CurrentProject.Path & "\" & CurrentProject.Name ' تحديد مسار قاعدة البيانات DB_Directory = CurrentProject.Path ' تحديد اسم قاعدة البيانات DB_Name = CurrentProject.Name ' تحديد مسار النسحة الاحتياطية Backup_Full_Name = strFolderPath & Left(DB_Name, Len(DB_Name) - 6) & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & ".accde" If MsgBox("هل تريد اجراء نسخة احتياطية من البرنامج؟", vbQuestion + vbYesNo, "نسخة احتياطية") = vbYes Then Set Copy_File = CreateObject("Scripting.FileSystemObject") Copy_File.copyfile DB_Full_Name, Backup_Full_Name, True End If تحياتي

في الملف المرفق منك لاحظت أن عدد الصفوف في الشيت a1 لم يتغير عن 500 وبعده صف المجموع الكلي هل عدد الصفوف هذه 500 ثابت في كل شيت ؟ أم ممكن أن يكون في شيت 500 وآخر 200 وآخر 700 ؟؟

أختي الفاضلة كنت قد سألتك من قبل هل عدد أوراق العمل sheets متغير؟؟ بمعنى هل يمكن زيادة عددأوراق العمل فيما بعد؟؟ وهل هيكلة الشيت ثابتة على ما هو موجود؟ بمعنى هل عدد الصفوف ثابت على 500 صف في كل شيت؟؟ الإجابة على الأسئلة السابقة ستفيد في عمل المطلوب بالكود تحياتي للجميع

مفيش أحسن من كده

عذرا أختي يوجد بالملف خطأ بسيط وهو جعل المدى متغير والصواب في دالة count if COUNTIF('A1'!$D$2:$D502;B9) والصواب في دالة sumif SUMIF('A1'!$D$3:$D$502;B9;'A1'!$E$3:$E$502) ويتم تكراره بعدد أوراق العمل

أختي الفاضلة يمكنك استعمال الدالة countif لجلب العدد والدالة sumif لجلب المجموع وتكرارها بعدد أوراق العمل الموجودة في ملفك أما غذا كان عدد أوراق العمل متغير فيلزم عملها بالكود تم تطبيق المعادلات على الورقتين الأوليين فقط في هذا الملف هنـــــــا تحياتي أبو عبد الله محمد صالح

أخي الكريم ابو حسام الكود صحيح ولكن الخطأ هو وضع اسم قاعدة البيانات بدون الامتداد في حقل dbname والصواب أن يكون مثلا mydbname.mdb حاول تجرب وتضع اسم القاعدة صحيح ستجد البرنامج يعمل لاحظ أن وقت التنفيذ موجود في الكود 12:55 pm يمكنك تغييره والتجريب

شكرا جزيلا أخ yahiaoui وجزاك الله خيرا على ما قدمت وأود أن أنبه الإخوة إلى ملحوظة رائعة في النسخة الحالية للمنتدى والتي تسمح لك بتحميل مضمون الموضوع في ثلاث صور 1-صورة للطباعة 2-صورة صفحة html 3-صورة ملف وورد ولتحميل جميع مشاركات أي موضوع اتبع الآتي تجد أسفل الموضوع هذه الصورة اضغط فيها على تحميل سيظهر لك صفحة أخرى كما بالصورة اضغط على ملف وورد سيت تحميل الموضوع كاملا على جهازك يمكنك تصفحة في أي وقت تحياتي أخوكم أبو عبد الله محمد صالح

أختي الفاضلة لحفظ ملف بصيغة 2007 وتحتوي على أكواد وماكرووات يجب حفظه بصيغة excel macro-enabled workbook أو ملف إكسل به وحدات ماكرو ممكنة كما في الصورة

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

من هذا المنطلق أدعو الإخوة والأخوات أعضاء المنتدى للانتقال إلى أوفيس 2007 وإلى كل حديث في عالم البرمجة والبرامج كل عام أنتم بخير