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

استبدلي في القائمة المنسدلة عبارة nagative-positive-nagative*15/100 بكلمة Part وأضيفي الى الكود كما في الصورة في المكان المناسب الملف مرفق Yara_Part_Pos_Neg_All.xlsb

تفضل بالتنسيقات الشرطية ... فيمكنك استخدام هذه المعادلة =OR(AND($D11="أعزب",$H11>=75),AND($D11="متزوج",$H11>=60)) مستند 02.xlsx

الميزة التي انتظرها الكثير من الطلاب والمعلمين والقراء عموما أصبحت الآن بدون برامج إضافية ضمن تحديثات ويندوز 10 الأخيرة windows 10 build 1803 32bit or 64bit تحويل النص المكتوب إلى صوت مسموع Text to sppech والأجمل أنها باللغة العربية ومعنى هذا أنك بدلا من أن تقرا الملف تسمعه ولا ينقصني سوى دعاؤكم بالخير #ostazmas

نموذج منبثق - Pop-up Popup.mdb

وهل الجدول لديك باسم Home اذا كان كذلك استخدم UPDATE Home SET Home.[رقم وتاريخ الوثيقة] = [رقم الوثيقة] & "في" & [تاريخ الوثيقة]; تحياتي

السلام عليكم احتجت مؤخرا لمراجعة مستندات كثيرة مع فريق عمل اون لاين و اثناء المراجعة الفردية قبل المناقشة، و ايضا أثناء المناقشة أون لاين، كثيرا ما اجتجت للتبديل بين وضعية اظهار و اخفاء التعديلات واظهار المستند النهائي بعد التعديل و اظهار المستند الأصلي و كل منها تتطلب ثلاثة خطوات 1- الذهاب الي قاءمة المراجعة إذا لم تكن هي المفعلة 2- ثم اختيار مربع السرد الخاص باظهار خيارات التعديلات Markup 3- ثم اختيار أحد الخيارات الفرعية، و عليه و نظرا لحاجتي لتكرار استخدام هذه الأوامر كثيرا اثناء المناقشة و اثناء مراجعتي للمستند قبل المناقشة، قمت بتسجيل تلك الاوامر كماكروهات ثم اضافتها فى ايقونات بجانب اوامر المراجعة كما تظهر الصورة ضمن المحموعة المسماة Arafa كما هو موضح بالصورة ، و ذلك لاستخدامها بسهولة و سرعة أكبر بدل عن اختيار قائمة المراجعة ثم مربع السرد ثم احد الخيارات أي ستبدال ثلاثة خطوات بخطوة واحدة و قد وجدت في ذلك توفيرا ملحوظا على الرغم من بساطة الامر ، لذا احببت مشاركة ذلك معكم و الأكواد هي Sub Markup_No() ' Hide all Markups With ActiveWindow.View.RevisionsFilter .Markup = wdRevisionsMarkupNone .View = wdRevisionsViewFinal End With End Sub Sub Markup_All() ' Show All Markup With ActiveWindow.View.RevisionsFilter .Markup = wdRevisionsMarkupAll .View = wdRevisionsViewFinal End With End Sub Sub Markup_Original() ' Markup_Original Macro With ActiveWindow.View.RevisionsFilter .Markup = wdRevisionsMarkupNone .View = wdRevisionsViewOriginal End With End Sub و يمكن أيضا اضافة تلك الاوامر الي قائمة الوصول السريع لكي تكون متاحة عند تفعيل اي قائمة و ذلك عن طريق اختيار الايقون ثم الضغط بالزر الايمن للفأرة و اختيار الاضافة لقائمة الوصول السريع و لمن لا يريد استخدام الاكواد هناك حل وسط بكفاءة أقل قليلاً ، حيث مازلت ستحتاج للضغط مرتين بدل من ثلاثة و لكن بطريقة اسهل و هو عن طريق اصافة الخيار الي قائمة الوصول السريع Quick Access Bar كما هو موضح فى الصورة التالية 1- اختار قائمة المراجعة و ثم مريع السرد الخاص باظهار التعديلات 2- اضغط على الزر الايمن للفأرة 3- اختيار الاضافة علي قائمة الخيارات السريعة Quick Access Toolbar 4- ستتم الاضافة كما هو مبين و لكن كما ذكرت فى هذا الحل ستحتاج عند الاستخدام للنقر مرتين و لكن بطريقة اسهل ودون الحاجة لاختيار القائمة الخاصة بالمراجعة

وعليكم السلام ورحمة الله وبركاته استخدم استعلام تحديث كالتالي UPDATE جدول1 SET جدول1.[رقم وتاريخ الوثيقة] = [رقم الوثيقة] & "في" & [تاريخ الوثيقة]; دمج الحقل.rar تحياتي

طيب ممكن ترفق البرنامج علشان اعدلك زى ما انت عايز ان شاء الله وياريت لو كامل بكون مشكور علشان اتعلم منه بخصوص المسار انا ممكن اعمل لك فكرة كل ما تنقل البرنامج بالصور فى نفس المكان ومن غير ما نعمل جدول للمسارات الصور تشتغل عادى ايه رايك ؟

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

جزاك الله كل خير على هذه المعلومة الجميلة

الـ current region هو النطاق الذي يمكنك التنقل به من أول خلية الى اخر خلية دون المرور بصفوف (أو أعمدة ) فارغة الخلايا الفارغة ضمن المربع الأحمر (مثلاً B3 ) هي ايضاً ضمن الـــcurrent region لانه يمكن الوصول اليها بنفس الشرط بينما الخلية E2 لا تحتسب ضمن current region لان العمود D فارغ و كذلك الخلية A7 لا تحتسب ضمن current region لان الصف 6 فارغ باختصار يمكن اعتبار الـــ current region مثل جزيرة في البحر يمكن ان يكون فيها شجر او سكان (الخلايا المليئة) و يمكن ان يكون فيها (لكن ليس كلها) مناطق خالية (الخلايا الفارغة) و عليك التنقل في ارض هذه الجزيرة دون أن تدوس بمياه البحر والـــ used range هو مجموعة من هذه الجزر لكل منها current region خاص بها يمكن تحديد current region بتحدبد اي خلية داخله والضغط على (Ctr+A) مرة واحدة و هذا جواب لماذا لا يعمل على جدول فارغ الصورة توضح ذلك

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

شيتات اعداد وتجهيز فاتورة المشتريات الخارجية وتوزيع المصاريف واحتساب المصاريف والتكاليف الاضافية قبل الادخال في النظام واعداد الفاتورة الاولية واحتساب المصاريف المشتركة مع الغير فاتورة المشتريات الخارجية.xlsx

جرب هذين الماكروين (النسخ يتم الى Sheet2 اذا لم تكن موجودة قم بانشائها) الأول اصرارك على استعمال الـــ current region الثاني النسخ العادي Option Explicit Sub copy_range_1() Rem copy Using CurrentRegion Dim Rag As Range Set Rag = Sheets("sheet1").Range("A1:W13"). _ SpecialCells(4) Rag.Formula = "=""""" Sheets("sheet1").Range("A1").CurrentRegion.Copy Sheets("sheet2").Range("A1").PasteSpecial Rag.Value = vbNullString With Sheets("sheet2").Range("A1").CurrentRegion .Value = .Value End With Application.CutCopyMode = False End Sub '++++++++++++++++++++++++++++++++++++ Sub copy_range_2() Rem Normal copy Sheets("sheet1").Range("A1:W13").Copy Sheets("sheet2").Range("A1").PasteSpecial Application.CutCopyMode = False End Sub

وعليكم السلام ورحمة الله وبركاته بالتأكبد معك النسخة الاصبية من البرنامج accdb او mdb ارفقها هنا وباذن الله نحاول حل المشكلة تحياتي

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

قم بتغيير الرقم 103 الى اي رقم تريد في المعادلة الأولى (مع الضغط غلى Ctrl+Shift+Enter) وليس Enter وحدها واسحب يساراً الى اخر عامود و نزولاً قدر ما تريد

وعليكم السلام-يمكنك استخدام هذه المعادلة =IF(I2="","",IF(I2+(J2*30.5)<TODAY()," ســـارى",DATEDIF(TODAY(),I2+(J2*30.5),"d"))) 1تنبيه عقود.xlsx

لا اعرف ما المشكلة عندك انا عندي يعمل بشكل ممتاز جرب ان تغير اسم الملف الى اي اسم تريد (باللغة الأجنبية) ثم ليس هذا الملف الذي رفعته لك الصورة توضح (لا وجود لكلمة Enter)

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Private Sub Form_Open(Cancel As Integer) Dim z0 z0 = DLookup("ID", "المستخدمين", "ID=forms!login!ID") If z0 = 2 Then Me.Command12.Visible = False Else Me.Command12.Visible = True End If End Sub المحل نسخة تجريبية_2.rar تحياتي

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

حرب هذا الملف صفحة Combo_Sheet الصفحة Target ما زالت موجودة لكنها مخفية تم حماية المعادلات لعدم العبث بها عن طريق الخطأ اذا احببت ان تقوم بتعديل شيء ما اذهب الى الصفحة الرئيسية تجد هناك الاسم الذي اخترته من الشيت Combo_Sheet باللون الاخصر (كي لا تقوم بالتفتيش عنه بين كل الاسماء) al7aer2_iist_Combo.xlsm

مشاركة مع اخي @ابو البشر مشكلة الجمع.accdb

هل هذا ما تريد أخي الكريم .... مشكلة الجمع.accdb

وجزاكم ربى اعلى درجات الجنان انشاء الله وكل المسلمين تحت امرك يا جميل الحمد لله الذى تتم بنعمته الصالحات

هلا هلا هلا والله بأستاذي الكريم واخى الحبيب تشتاق إليكم الجنان ان شاء الله

اولا اانا مش متعصب ولا حاجة وما اقدرش اتعصب اصلا على اخوانى الكرام بس انا مش فاهم ارد على ايه على مشكلة ما اتحلت اصلا واللا على الاستعلام كنت محتاج افهم علشان اعرف ارد بخصوص الاستعلام بص يا سيدى اولا انا ضيفت خقل جديد فى جدول جرد الفواتير باسم idCategory نوعه رقم واضفت له مفتاح السب عدم تكرار السجلات --------------------- ثم انشأت استعلام الحاق وطبعا ما ينفعش يكون فاضى افتح الاستعلام اللى انا عملته لحضرتك فى وضع التصميم تلاقيه كالاتى التظليل فى الصورة اللى باللون الاخضر دى البيانات اللى احنا محتاجين ننسخها من جدول الاصناف التظليل فى الصورة اللى باللون الاحمر اسماء الحقول المقابلة لها والتى سيتم نسخ البيانات اليها فى جدول جرد الفواتير لاحظ بس ان حضرتك عندك حقل فى جدول جرد الفواتير مش موجود فى جدول الاصناف وهو الحالة وحضرتك تريد فيها قيمة ثابته وهى "متوفرة" حضرتك عملت الاستعلام فاضى بدون تحديد الحقول الاساسية المراد النسخ منها ومقابلها فى الجدول الاخر المراد النسخ اليها انظر الشرح كما بالصور التى ارسلتها اليك

نعم عادي مافيها شيئ DoCmd.Close acForm, "AT" DoCmd.Maximize

بارك الله فيك استاذ حسين _ بعد اذنك ولإثراء الموضوع .. على ان يكون ايضاً الكود بهذا الشكل Private Sub CommandButton1_Click() If UserForm1.TextBox1.Value = "admin" And UserForm1.TextBox2.Value = 2020 Or UserForm1.TextBox1.Value = "ali" And UserForm1.TextBox2.Value = 456 Then Application.Visible = True UserForm1.Hide If UserForm1.TextBox1.Value = "admin" And UserForm1.TextBox2.Value = 2020 Then Sheet5.Select End If If UserForm1.TextBox1.Value = "ali" And UserForm1.TextBox2.Value = 456 Then Sheet1.Select End If Else MsgBox "بـرجاء مراجـعـة اســم المستخدم وكلمـة المـرور", , "Error" Label4.Caption = Label4.Caption - 1 If Label4.Caption = 0 Then ThisWorkbook.save Application.Quit End If End If End Sub شيت فاتورة مبيعات .xlsm

try this file WiAAM.xlsx

تم التعديل كما تريدين الأعداد السالبة تظهر باللون الأصفر والموجبة بالأخضر(شرط تطابق التاريخ) حلايا التاريخ المطلوب باللون الزهري Option Explicit Sub get_special_columns() Dim D As Worksheet Dim Sh As Worksheet Dim Ar(), Min_date As Date, Max_date As Date Dim K%, t%, Arr_sh() Dim My_ro%, m%, ro%, my_sum#, x% Dim Sum_pos#, Sum_Neg# K = 2 Set D = Sheets("DataReport") D.Rows.Hidden = False If D.Range("A3").CurrentRegion.Rows.Count > 1 Then D.Range("A3").CurrentRegion.Offset(1). _ Resize(D.Range("A3").CurrentRegion.Rows.Count - 1).Clear End If If Not IsDate(D.Range("J2")) Or _ Not IsDate(D.Range("K2")) Then Exit Sub Min_date = Application.Min(D.Range("J2:K2")) Max_date = Application.Max(D.Range("J2:K2")) Ar = Array("E", "F", "G", "H", "I", "J") For Each Sh In Sheets If Sh.Tab.ColorIndex = D.Range("N1") Then ReDim Preserve Arr_sh(m) Arr_sh(m) = Sh.Name: m = m + 1 End If Next Sh If m = 0 Then Exit Sub For m = LBound(Arr_sh) To UBound(Arr_sh) D.Cells(K, 1) = Arr_sh(m) D.Cells(K + 1, 1) = "Total " & D.Cells(12, "J") D.Cells(K + 1, 1).Resize(, UBound(Ar) + 2).Interior.ColorIndex = 20 K = K + 2 Next m My_ro = 3 For m = LBound(Arr_sh) To UBound(Arr_sh) Set Sh = Sheets(Arr_sh(m)) Sh.Range("A5:J20000").Interior.ColorIndex = xlNone ro = Sh.Cells(Rows.Count, 1).End(3).Row For K = LBound(Ar) To UBound(Ar) t = K + 2 For x = 5 To ro If Sh.Cells(x, 1) <= Max_date _ And Sh.Cells(x, 1) >= Min_date Then Sh.Cells(x, 1).Interior.ColorIndex = 40 If Val(Sh.Cells(x, Ar(K))) <> 0 Then my_sum = my_sum + Sh.Cells(x, Ar(K)) '+++++++++++++++++++++++++++++ If Val(Sh.Cells(x, Ar(K))) <= 0 Then Sum_Neg = Sum_Neg + Val(Sh.Cells(x, Ar(K))) Sh.Cells(x, Ar(K)).Interior.ColorIndex = 6 Else Sum_pos = Sum_pos + Val(Sh.Cells(x, Ar(K))) Sh.Cells(x, Ar(K)).Interior.ColorIndex = 35 End If '++++++++++++++++++++++++++ End If End If Next x Select Case D.Cells(12, "J") Case "Positive" D.Cells(My_ro, t) = Sum_pos Case "Nagative" D.Cells(My_ro, t) = Sum_Neg Case Else D.Cells(My_ro, t) = my_sum End Select my_sum = 0: Sum_pos = 0: Sum_Neg = 0 Next K My_ro = My_ro + 2 Next m D.Cells(My_ro, 1) = "Sum Of All" Rem D.Cells(My_ro - 1, 2).Resize(, UBound(Ar) + 1) = Ar With D.Cells(My_ro - 1, 2).Resize(, 6) .Value = D.Cells(1, 2).Resize(, 6).Value .Interior.Color = vbBlue .Font.Color = vbWhite End With D.Cells(My_ro, 2).Resize(, UBound(Ar) + 1).Formula = _ "=Sum(B3:B" & My_ro - 2 & ")" D.Cells(My_ro, 1).Resize(, UBound(Ar) + 2).Interior.ColorIndex = 6 If D.Range("A3").CurrentRegion.Rows.Count > 1 Then With D.Range("A3").CurrentRegion.Offset(1). _ Resize(D.Range("A3").CurrentRegion.Rows.Count - 1) .Borders.LineStyle = 1: .Font.Size = 14 .Font.Bold = True: .HorizontalAlignment = xlCenter .Value = .Value End With End If For m = My_ro - 2 To 3 Step -1 If D.Cells(m, 1) Like "Total*" And _ Application.Sum(D.Cells(m, 2).Resize(, 6)) = 0 Then D.Range(Cells(m, 1), Cells(m - 1, 1)).EntireRow.Hidden = True End If Next End Sub '++++++++++++++++++++++++++++++ Sub show_all() Sheets("DataReport").Rows.Hidden = False End Sub الملف مرفق Yara_Pos_Neg_All.xlsb

السلام عليكم واجهتني مشكلة اخري فى الملفات الكبيرة ، و هى أنه عند التبديل بين الثلاثة وضعيات ، يتغير موقع المؤشر ، خاصة عندما تكون البيانات ضمن جداول فمثلا و انت تراجع البند رقم 200 ، عند اختيار اظهار النسخة الاصلية ينتقل المؤشر للبند 140 مثلا ، حيث أنه يبدو ان ذلك يعتمد على عدد الاسطر او موقع المؤشر ، دون مراعاة النص الظاهر ، ففي حالة الوضع الاصلي يكون عدد الاسطر اقل بالطبع و بالتالي تجد المؤشر فى مكان مختلف و الحل هو حفظ مكان المؤشر قبل تبديل طريقة الاظهار Dim currentPosition As Range Set currentPosition = Selection.Range و العودة له فى نهاية كل كود currentPosition.Select و طبعا يمكن استخدام خاصية ايقاف و تفعيل خاصية تحديث الشاشة فى بداية و نهاية الكود كي لا يشعر المستخدم بعملية الانتقال Application.ScreenUpdating = False Application.ScreenUpdating = True و عليه تكون الاكواد النهائية Sub Markup_No() ' Hide all Markups Application.ScreenUpdating = False Dim currentPosition As Range Set currentPosition = Selection.Range With ActiveWindow.View.RevisionsFilter .Markup = wdRevisionsMarkupNone .View = wdRevisionsViewFinal End With currentPosition.Select Application.ScreenUpdating = True End Sub Sub Markup_All() ' Show All Markup Application.ScreenUpdating = False Dim currentPosition As Range Set currentPosition = Selection.Range With ActiveWindow.View.RevisionsFilter .Markup = wdRevisionsMarkupAll .View = wdRevisionsViewFinal End With currentPosition.Select Application.ScreenUpdating = True End Sub Sub Markup_Original() ' Markup_Original Macro Application.ScreenUpdating = False Dim currentPosition As Range Set currentPosition = Selection.Range With ActiveWindow.View.RevisionsFilter .Markup = wdRevisionsMarkupNone .View = wdRevisionsViewOriginal End With currentPosition.Select Application.ScreenUpdating = True End Sub

ارج التعقيب اذا امكن