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

تفضل جرب test.xlsm

السلام عليكم الاخوة الافاضل عبارات الشكر لا تفى حقكم لأنكم أكبر منها، فأنتم لكم الفضل في تحويل الفشل إلى نجاح، ورفع العزيمة والمعنوية لدي، فأنتم أهل التميز استاذنا الفاضل وجيه شرف الدين الف الف شكر لحضرتك على مجهودكم الكود يعمل و ينفذ المطلوب باحترافيه عالية استاذنا الفاضل الخلوق محمد هشام. بارك الله فى عمرك و الف الف شكر على تعبك الكود رائعه و ينفذ المطلوب و كما عودنا لا تبخل بجهدك ربنا يحفظك و يبارك فى حضرتك و اسرتك الكريمة استاذنا الفاضل

السلام عليكم مداخلة لتوضيح مفهوم العلاقات 1- اخوي خليفة استخدم الحروف العربية في تسمية الحقول .. وهذا متعب برمجيا 2- اعتقد اغلب جداولك خدمية بمعنى انها ستحتوي على بيانات ثابتة ما عدا جدول واحد هو المتغير وربما اثنين لم أتأكد .. وهذا الجدول هو محل العمليات وهذا يعني ان جميع الجداول الخدمية سترتبط به بمعنى يجب ن يحتوي هذا الجدول على حقول ترتبط بالجداول الاخرى سواء بعلاقة او يكفي ضبط النوع والتنسيق 3- مادمت ستربطه بالفيجوال بيسك انصحك بترك الجداول بلا علاقات .. واستخدمها في الاستعلامات داخل المشروع ايضا شرحك للحالة مقتضب والافضل الاسترسال في الشرح مثلا هل كل حاوية تحتوي على مادة واحدة فقط او اكثر .. وتساؤلات اخرى كثيرة عملية بناء الجداول بطرق علمية صحيحة يعتبر 80% من المشروع

ممكن توضح لنا المطلوب تفصيلاً 😊

تفضلي محاولتي البسيطة stopwatch.accdb قمت بجعل قيمة مربع النص للدقائق بقيمة افتراضية = 0 فقط

ضعي هذا الكود في حدث عند النقر للزر If Normal = "sex" Then DoCmd.OpenForm "normals_frm" Else MsgBox "قم بادخال قيمه صحيحه", , "" End If

وعليكم السلام ورحمة الله تعالى وبركاته ربما تقصد جمع قيم العمود بشرط الخلفية الزرقاء تفضل جرب وضع هدا لكود في موديول Function TotalRng(SumRange As Range, SumColor As Range) Dim SumColorValue As Integer Dim SumRng As Long SumColorValue = SumColor.Interior.ColorIndex Set b = SumRange For Each b In SumRange If b.Interior.ColorIndex = SumColorValue Then SumRng = SumRng + b.Value End If Next b TotalRng = SumRng End Function وفي الخلية H17 =TotalRng(البيانات!$H$2:$H$80;K1) مع تلوين الخلية K1 باللون الهدف فرز بيانات ذات اللون 2الازرق.xlsm

بعد تجارب كثيرة ، خرجت بهذه النتيجة ؛ ولكن يبدو أنك سبقتني بفكرة وهذه فكرتي last datex.accdb

كل الشكر للمبدع عمر ضاحى

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

أنا شخصيا في مثل هذه الحالة أفتح الصورة في مستعرض الويندوز الافتراضي بالأمر shell وبالنسبة لطلبك في الضغط على الزر يمكنك استعمال مثل هذا الكود Private Sub CommandButton1_Click() Call Add_Image End Sub وفي موديول جديد نستعمل هذا الكود Sub Add_Image() Set Img = UserForm2.Controls.Add("Forms.Image.1") With Img .Picture = LoadPicture("مسار الصورة") .PictureSizeMode = fmPictureSizeModeStretch .Left = 10 .Top = 10 End With End Sub بالتوفيق

كتابة اسم الشيت بها احتمالات للخطأ الأفضل اختيار الاسم من قائمة بأسماء الشيتات ساعتها يمكنك استخدام أمر فتح الشيت Sheets(Range("a1").Text).Activate بالتوفيق

تفضل اخي Option Explicit Sub FILTRE() ' فلترة البيانات بين تاريخين واسم القسم Dim i&, R, LastRow As Long, rngCell, c As Range Dim a(1 To 3) a(1) = [BK1]: a(2) = [BK2]: a(3) = [BP1] Dim MyRng As Range Dim WSdata As Worksheet: Set WSdata = ThisWorkbook.Sheets("Sheet1") Application.ScreenUpdating = False WSdata.Range("BJ5:BY1000").ClearContents Set MyRng = WSdata.Range("AM2:BD" & WSdata.Cells(WSdata.Rows.Count, "am").End(xlUp).Row) R = MyRng For i = 1 To UBound(R) If R(i, 17) >= a(1) And R(i, 17) <= a(2) And R(i, 18) = a(3) Then WSdata.Range("BJ" & Rows.Count).End(xlUp).Offset(1).Resize(1, 16).Value _ = Array((R(i, 1)), (R(i, 2)), (R(i, 3)), (R(i, 4)), (R(i, 5)), (R(i, 6)), (R(i, 7)), (R(i, 8)), (R(i, 9)), (R(i, 10)), (R(i, 11)), (R(i, 12)), (R(i, 13)), (R(i, 14)), (R(i, 15)), (R(i, 16))) End If Next ' تسطير البيانات LastRow = WSdata.Range("BJ:BY").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Set rngCell = WSdata.Range("BJ5 :BY" & LastRow) WSdata.Range("BJ5:BY1000").Borders.LineStyle = xlNone For Each c In rngCell.Rows If WorksheetFunction.CountA(c) > 0 Then c.Borders.LineStyle = xlContinuous Next If Application.WorksheetFunction.CountA(WSdata.Range("BJ5:BY5")) = 0 Then MsgBox "ليس هناك بيانات مطابقة لمعايير الفلترة الحالية", vbOKOnly + vbCritical + vbDefaultButton1 + vbApplicationModal, "انتباه" End If Application.ScreenUpdating = True End Sub اظافات ممكن تفيدك للاشتغال على الملف بشكل افضل Sub CreateValidation() 'انشاء قوائم التاريخ والقسم تلقائيا بدون تكرار Dim J, K, lr As Long Dim a(1 To 2) As String Dim WSdata As Worksheet: Set WSdata = Worksheets("Sheet1") lr = WSdata.Range("BC:BD").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row J = WSdata.Range("BC2:BC" & lr): K = WSdata.Range("BD2:BD" & lr) J = column(Application.Transpose(J)): a(1) = Join(J, ",") K = column(Application.Transpose(K)): a(2) = Join(K, ",") With WSdata.Range("BK1:BK2").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=a(1) End With With WSdata.Range("BP1").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=a(2) End With End Sub Function column(arr) As Variant With Application column = .Index(arr, 1, Filter(.IfError(.Match(.Transpose(.Evaluate("ROW(1:" & _ UBound(.Match(arr, arr, 0)) & ")")), .Match(arr, arr, 0), 0), "|"), "|", False)) End With End Function وفي حدث ورقة1 انسخ الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) ' تحديث القوائم عند الاظافة او التعديل في عمود التاريخ او القسم On Error Resume Next lr = Range("BC" & Rows.Count).End(xlUp).Row If Not Intersect(Target, Range("BC2:BC" & lr)) Is Nothing Then Application.EnableEvents = False Call CreateValidation Application.EnableEvents = True Exit Sub End If ' تنفيد الكود عند التغيير في خلية القسم If Not Intersect(Target, Target.Worksheet.Range("BP1")) Is Nothing Then If Target.Cells.Value = " " Or IsEmpty(Target) Then Exit Sub Call FILTRE Application.EnableEvents = True End If On Error GoTo 0 End Sub استخراج بالتاريخ 2.xlsm

وعليكم السلام ورحمة الله وبركاته تفضل الملف لعله يفى بالمطلوب استخراج بالتاريخ.xlsm

السلام عليكم ورحمة الله وبركاته وبها نبدأ من فترة كبيرة لم أدخل المنتدى وبالفعل أشتاق اليكم يشرفني ان ارفع شرح أحد الأفكار البسيطة كنت قد قدمتها وهي بالفعل نقطة في بحر القائمين على المنتدى

أخي الكريم طلبك هذا يدل على احتياجك لتعلم أساسيات الاكسل يمكنك استخدام هذه المعادلة =MAX(A2:C2) بالتوفيق

الموضوع بسيط جدا جدول لتخزين البيانات مع ربط صورة الاستمارة في مجلد الصور برقم الطلب ربما يفيدك هذا الموضوع لدراسته وتنفيذ فكرته بالتوفيق

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

Sub test1() Dim WS As Worksheet: Set WS = ActiveSheet '<<<---- Worksheets("27-10-2023الى2-11-2023") 'اسم ورقة العمل Dim lastrow As Long, ligne As Range, search As Rang Set ligne = [U4] '<<<----' خلية اللصق Set search = [L19] '<<<-- اي القيمة التي تم جلبها من الخلية '<<<---اول تاريخ على الجدول ("A4") ' '("U")' تحديد اخر خلية بها بيانات من عمود lastrow = WS.Cells(Rows.Count, 23).End(xlUp).Row + 1 ' لمنع التكرار '*********************** '("U") 'التحقق من وجود نفس تاريخ المدفوعات مسبقا في عمود ' ' في حالة وجوده يتم ايقاف تنفيد الكود مع رسالة اشعار If Application.WorksheetFunction.CountIf(WS.Range("U:U"), search) > 0 Then MsgBox " يوجد نفس الفترة في المدفوعات " & search, vbOKOnly + vbCritical + vbDefaultButton1 + vbApplicationModal, "انتباه": Exit Sub A = [L19:Q51].Value ''<<<----'نطاق البيانات المرحلة If ligne = 0 Then ' '<<<----التحقق من عدم وجود قيمة في خلية اللصق ' U4'في حالة فراغها يتم لصق البيانات ابتداءا من الخلية [U4].Resize(UBound(A), UBound(A, 2)).Value2 = A Else ' U ' في حالةوجودقيمة يتم لصق البيانات بعد اخر صف به بيانات من عمود Range("U" & lastrow).Resize(UBound(A), UBound(A, 2)).Value2 = A End If MsgBox "تم ترحيل مدفوعات" & " " & search & " " & "بنجاح", vbInformation End Sub

اعداد كشوفات مدرسية باختيار روؤس الاعمدة عن طريق فورم بطريقة ابسط للفهم وسهولة نقلها الى اي ملف مع تضبيط الطباعة مع الشرح اعداد كشوفات مدرسية باكواد سهلة التغيير والتي تجعل استخدامه ونقلة الى ملف آخر للعمل عليه بشكل مبسط وتتم التغييرات في مكان واحد في اول الكود هنا : '====================================================== ' اول صف للتقرير Private Const iRow As Integer = 4 '------------------------------------------------------ ' اسم ورقة التقارير Private Const Sh_Report As String = "التقرير" '------------------------------------------------------ ' اسم ورقة البيانات Private Const Sh_MyDate As String = "بيانات اساسية" '------------------------------------------------------ ' تعيين نطاق الخلايا في ورقة البيانات ' ويشمل رؤوس الاعمدة Private Const MyRng_MyDate As String = "A5:X1000" '====================================================== ويمكن يستخدم لاي كشوفات وتقارير او غيره و ساقوم بشرح هذا العمل على شكل دفعات رويدا رويدا وسوف نبدأ اليوم بارفاق الملف وسيتبعه الشرح ان شاء الله خبور خير اعداد تقارير مدرسية.rar

الاخ محمد الريفي بارك الله فيك وجزاك الله خيرا الأخ إبراهيم أبو ليلة الحل كان ع السريع إليك الملف التالي عله ينال إعجابك وينال رضاك Unique List No Blanks YasserKhalil.rar

الأخ الفاضل صلاح يرجى عدم إرسال رسالة خاصة فيها طلب مساعدة ..أنا أقوم بالإطلاع على الموضوعات وإذا كان لدي فكرة وحل ووقت قمت بمد يد العون بإذن الله بدون إلحاح .. تفضل الملف المرفق عله يكون المطلوب (ولا تنسى أن تختار المشاركة التي أعجبتك كأفضل إجابة كي تكون دليل للباحث فيما بعد) Validation List VBA And Zoom.rar

نفس الملف لكن القائمة المنسدلة في صفحة اخرى بناءً على طلب السائل sotrted val liste.rar

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

سعيد جدا بمروركم أخي سعيد بيرم وأخي سعد عابد أسعد الله أيامكم أتمنى الرد بعد التحميل والتسطيب فأنا في غاية الإعجاب بهذه النسخة وأريد أن أعرف هل هذا موقفي وحدي؟ .................. ولمزيد من المعلومات عن النسخة تم تعديل قائمة start حيث تم حذفها من سطح المكتب واستعمال أركان سطح المكتب لأداء مهام كثيرة جداً تم استعمال الشريط ribbun في نوافذ مستكشف الويندوز العادية مثل أوفيس 2010 تم استعمال 3 حروف للدلالة على اللغة في شريط المهام ( عرب - Eng ) تم تضمين مضاد للفيروات قوي جداً بحيث لا تحتاج معه لمضاد فيروسات السرعة في تنفيذ المهام تغيير شكل مدير المهام task manager بصورة احترافية لا تحتاج لأي تعريفات من أي نوع حتى ما كانت ويندوز 7 تقف عنده وتحتاج إلى تعريفات له تم ربط جهازك ببريدك الخاص بشركة ميكروسوفت سواء live أو hotmail يمكنك ربط حساب بريدك بجميع حسابات التواصل الاجتماعي والإعلان بها بدون فتح المواقع والرد عليها كذلك .... ... ... والكثيييييييييييييير أتمنى معرفة آراء الإخوة فيها

بارك الله لكل من ساهم في حل مشكلة أخيه وخلاصة الأمر لجعل الأرقام تظهر باللغة العربية في إكسل يجب توافر شرطين * الأول هو جعل اتجاه النص من اليمين لليسار من خلال الضغط على ctrl+1 لفتح نافذة تنسيق الخلايا * الثاني هو جعل تنسيق الأرقام باللغة العربية من لوحة التحكم control panel ---> ثم خيارات اللغة والمنقطة الإقليمية regional and language options ---> وفي التبويب الأول الخاص بتنسيق الأرقام والتواريخ والوقت وغير ذلك نختار من القائمة العلوية بلدك العربية (أنا أختار مصر) بدون الدخول في تفاصيل يتم تغيير الأرقام والتواريخ وفقنا الله وإياكم لكل ما يحب ويرضى اللهم احفظ مصر وأهلها من كل سوء

بارك الله لك أخي عبد الله مثال رائع حقاً أخي الكريم قصي المثال يصلح لما تريد فقط يلزمك وضع صور للطلاب في مجلد الصور واجعل اسم صورة كل طالب هي رقم مسلسله مثلا ثم اكتب في الخلية الخاصة باسم الصورة رقم الطالب سيتم عرض صورته

شكرا لك أخي الحسين ولكن في رأيي الشخصي أفضل برنامج لتسجيل الشروحات هو camtasia studio 7.1 http://www.techsmith.com/camtasia.html فبه الكثير من الإمكانيات التي لا توجد في غيره أدعوك لتجربته البرنامج المذكور من حضرتك يشبه كثيرا برنامج bb flashback http://www.bbsoftwar...hback/home.aspx وفقنا الله وإياكم لكل ما يحب ويرضى

شكرا لك أخي الكريم عطاء يدل على الكرم وحب الغير بارك الله لك

لعلك تقصد هذا الملف http://www.officena.net/ib/index.php?showtopic=29972 أتمنى تفيدك هذه الأداة وتتخدمها فيما يرضي الله

شكرا جزيلا استاذ محمد برجاء التكرم بأضافة كوذ يعيد الصفحة الى قبل الفرز أخي الكريم استعمل هذا الكود Sub nofilter() ActiveSheet.ShowAllData End Sub

بارك الله لك أخي العيدروس وبناء على طلب أستاذ أحمد تم تعديل الكود ليتم استدعاؤه من صفحة أخرى ولتكن مثلا sheet3 mas_مطلوب فرز ALIDROOS.rar

بارك الله لك أخي أبا نصار استعمال للكود بطريقة تدل على فهم صائب وبارك الله لك أخي أحمد ربط بين المعادلات والكود رائع وأرجو أن يتسع صدرك للتعديل البسيط على الكود (فهوايتي اختصار الأكواد) Sub mSaveAs() If Range("H7") = False Then QQ = Range("J7") MsgBox QQ Exit Sub End If FN = Range("G7") ActiveWorkbook.SaveAs Filename:=FN End Sub للملاحظة تم الاستغناء عن سطري الذهاب إلى السطر رقم 9 والسطر نفسه واستبدالهما ب جملة الخروج من الإجراء

اخي "ابو الشرف" ارجو ان اكون قد وفقت في اتمام المطلوب ... جرب الملف التالي sales rep sc food non food2.rar

السلام عليكم Union غرض Range يمثل اجتماع مجموعة نطاقات متجاورة او غير متجاورة

هذا نفس الملف أضفت إليه كود الرأس و التذييل ستجد ذلك عند معاينة الطباعة رقم الصفحة أعلى اليسار أسفل يمين اللجنة : أسفل وسط : وكيل ش ط + اسمه من الورقة 1 أسفل يسار مدير المدرسة + اسمه مجلوب من الورقة 1 اعداد تقارير مدرسية - مع الرأس والتذييل.zip

بارك الله لك جميل جدا ورغم كل هذا نحن لا نستخدم الا 10٪ من مميزات الاكسل بالتوفيق