كل الانشطه

السلام عليكم ورحمة الله وبركاته لدى كود جيد ويؤدى وظيفتة بدقه وهو يتعامل مع ثلاث أوراق طلبى هو زيادة سرعته فهو يأخذ حوالى 7 ثوانى فى تنفيذ مهامه شكراً لكم وبالتوفق 'كود جلب بيانات Private Sub Worksheet_Change(ByVal Target As Range) If Cells(4, 2).Value = "ON" Then ' لإيقاف وتشغيل الكود Dim ws As Worksheet, tbl As Long, tmp As Long, i As Long Dim n As String, Max As Long, ky As Boolean Max = 461 If Not Intersect(Target, Range("D2,D4,B4,B7")) Is Nothing Then Set ws = Sheets("حساب الفوائد") Set SA = Sheets("مؤشر الفائدة") Set SB = Sheets("P") '------------------------------------------------------------------------------------------ 'استخراج البيانات المطلوبة من بيانات الشهادات 'On Error Resume Next Application.ScreenUpdating = False Application.Calculation = xlCalculationAutomatic SA.Range("BH2") = 2 'مسح البيانات من منطقة منطقة عرض البيانات SA.Range("D6:BC207").ClearContents ws.Range("DN26:FA225").ClearContents ws.Range("FG26:HF225").ClearContents '-------------------------------------------------------------------------------------------------- 'فك البيانات Application.ScreenUpdating = False Dim sp As Variant, j&, lr& With Application .ScreenUpdating = False: .Calculation = xlCalculationManual .ErrorCheckingOptions.BackgroundChecking = True End With lr = ws.Cells(ws.Rows.Count, "DK").End(xlUp).Row For j = 26 To lr sp = Split(ws.Cells(j, "DK").Value2, "*") For i = LBound(sp) To UBound(sp) ws.Cells(j, i + 118).NumberFormat = "@" ws.Cells(j, i + 118).Value = sp(i) Next i Next j With Application .ScreenUpdating = True: .Calculation = xlCalculationAutomatic .ErrorCheckingOptions.BackgroundChecking = False End With '------------------------------------------------------------------------------------------- 'نسخ البيانات المفككة إلى إلى ورقة عرض البيانات Application.ScreenUpdating = False ws.Range("DN26:FA225").SpecialCells(xlCellTypeVisible).COPY ws.Range("FL26:GY225").PasteSpecial xlPasteValues '--------------------------------------------------------------------------------------------- 'معادلة لضرب عدد الأشهر فى قيمة الفائدة الشهرية If SA.Range("BJ4") = 33 Then ws.Range("FL26:GY26") = ws.Range("FL25:GY25").Formula ws.Range("FL26:GY26").AutoFill Destination:=ws.Range("FL26:GY225"), Type:=xlFillDefault End If '----------------------------------------------------------------------------------------------- Application.ScreenUpdating = False 'معادلات لتكون صفحة العرض بلا معادلات If SA.Range("BJ4") = 33 Or SA.Range("BJ4") <> 33 Then ws.Range("FG26:FK225") = ws.Range("FG25:FK25").Formula ws.Range("FG26:FK225") = ws.Range("FG26:FK225").Value ws.Range("GZ26:HF225") = ws.Range("GZ24:HF24").Formula ws.Range("GZ26:HF225") = ws.Range("GZ26:HF225").Value SA.Range("D7:H7") = ws.Range("FG24:FK24").Value SA.Range("F4:H6") = ws.Range("FI21:FK23").Value SA.Range("AW6:BC7") = ws.Range("GZ22:HF23").Value End If ' ----------------------------------------------------------------------------------------------- ws.Range("FL24:GY24").SpecialCells(xlCellTypeVisible).COPY SA.Range("I7:AV7").PasteSpecial xlPasteValues ws.Range("FG26:HF225").SpecialCells(xlCellTypeVisible).COPY SA.Range("D8:BC207").PasteSpecial xlPasteValues ' ----------------------------------------------------------------------------------------------- Application.ScreenUpdating = False SB.Range("D8:L208").ClearContents SA.Range("D6:H207").SpecialCells(xlCellTypeVisible).COPY SB.Range("D7:H208").PasteSpecial xlPasteValues SA.Range("F4:H6").SpecialCells(xlCellTypeVisible).COPY SB.Range("F5:H7").PasteSpecial xlPasteValues ws.Range("HI25:HL225").SpecialCells(xlCellTypeVisible).COPY SB.Range("I8:L208").PasteSpecial xlPasteValues SA.Range("J5") = SA.Range("BQ5").Value ' ----------------------------------------------------------------------------------------------- 'لإخفاء الأعمده الفارغة Application.ScreenUpdating = False For s = 9 To 54 If Cells(7, s).Value = "" Then Columns(s).EntireColumn.Hidden = True Else Columns(s).EntireColumn.Hidden = False End If Next s 'إحتواء منسب الأعمده For s = 9 To 54 If Cells(7, s).Value <> "" Then Columns(s).AutoFit End If Next s '------------------------------------------------------------------------------------------ 'لتغير الخطوط Application.ScreenUpdating = False If Sheets("مؤشر الفائدة").Range("B7") = 1 Then Sheets("مؤشر الفائدة").Range("AY8:AY207, BB8:BB208,BR2:BR4").Select With Selection.Font .Name = "Wingdings 3" .Size = 14 Selection.HorizontalAlignment = xlCenter End With End If If Sheets("مؤشر الفائدة").Range("B7") = 2 Then Sheets("مؤشر الفائدة").Range("AY8:AY207, BB8:BB208,BR2:BR4").Select With Selection.Font .Name = "Arial" .Size = 16 Selection.Font.Bold = True Selection.HorizontalAlignment = xlCenter End With End If If Sheets("مؤشر الفائدة").Range("B7") = 3 Then Sheets("مؤشر الفائدة").Range("AY8:AY207, BB8:BB208,BR2:BR4").Select With Selection.Font .Name = "Arial" .Size = 16 Selection.HorizontalAlignment = xlCenter End With End If Application.ScreenUpdating = False '----------------------------------------------------------------------------------------- ' لتلوين برواز الخلية ALP Application.ScreenUpdating = False If SA.Range("BJ6") = 5 Then SA.Range("AZ6").Select With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Color = -10839132 End With With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Color = 0 End With End If If SA.Range("BJ6") <> 5 Then SA.Range("AZ6").Select With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Color = 0 With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Color = -10839132 End With End With End If ' ------------------------------------------------------------------------------------------------ 'P للتنسيق فى ورقة Sheets("P").Select Application.ScreenUpdating = False If Sheets("P").Range("I8") = "إجمــاليــات" Then Sheets("P").Range("$I$9:$J$208").Select With Selection.Font Selection.HorizontalAlignment = xlRight Selection.NumberFormat = "#,##0.00" Sheets("P").Range("$I$7:$J$208").Select Selection.Columns.AutoFit Sheets("P").Range("$K$8").Select Selection.Columns.Hidden = False End With Sheets("P").Range("D8").Select End If If Sheets("P").Range("I8") = "عدد" Then Sheets("P").Range("$I$9:$J$208").Select With Selection.Font Selection.HorizontalAlignment = xlCenter Selection.NumberFormat = "General" Sheets("P").Range("$I$8:$K$208").Select Selection.Columns.AutoFit Sheets("P").Range("$K$8").Select Selection.Columns.Hidden = True End With Sheets("P").Range("D8").Select End If Sheets("مؤشر الفائدة").Select Application.ScreenUpdating = Fals ActiveSheet.Shapes.Range(Array("مستطيل 10")).Select Application.ScreenUpdating = False If Selection.Text = "إخفاء الأعمدة" Then With Selection Selection.Text = "إظهار الأعمدة" .Font.Color = -4072739 .ShapeRange.Fill.ForeColor.RGB = _ RGB(15, 15, 15) .ShapeRange.Line.ForeColor.RGB = _ RGB(169, 158, 103) End With End If End If Sheets("مؤشر الفائدة").Range("I7").Select End If End Sub

السلام عليكم - محتاج شاشة افتتاحية للبرنامج اللي عندي - فعند فتح البرنامج تظهر شاشة جميلة قبل الدخول الى البرنامج وتحتوي على رقم سري ممنون

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

حل اخر للطلب لعله يكون المطلوب ويفي بالغرض اذا ارات البحتث من خلال فتره معينه مثلا من يوم 1 الي يوم 10 من هتكون في الخليه e3 الي هتكون في الخليه f3 كما في الصوره المرفقه Copy of جدول ورديات (1).xlsm

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

هل تعرف اختصار Ctrl+D فيما يستخدم؟ يستخدم لتكرار العنصر المحدد.

شكرا لك أخي @Bshar .. 🙂

السلام عليكم .. ممكن تعديل بسيط فى البحث بالتاريخ يكون يالتاريخ من1فى الشهر الى 31 وليس بالايام ولكم جزيل الشكر مقدما

السلام عليكم .. تمام تسلم ايدك .. وجزاك الله خيرا كثيرا متشكر جدا

وعليكم السلام ورحمة الله وبركاته .. جرب التعديل التالي على الزر cmdOK في النموذج frmTimeTo :- Private Sub cmdOK_Click() Dim strDuration As String Dim frmTarget As Form Dim strTime As String Dim blnValid As Boolean Dim Hours As Integer Dim Minutes As Integer Dim TotalMinutes As Long On Error GoTo ErrorHandler '========================== ' التحقق من إدخال الوقت '========================== If Trim(Nz(Me.mdfo, "")) = "" Then MsgBox "أدخل التوقيت", vbExclamation, "تنبيه" Me.mdfo.SetFocus Exit Sub End If strTime = Trim(Me.mdfo) '========================== ' التحقق من التنسيق 00:00 '========================== If Len(strTime) = 5 And Mid(strTime, 3, 1) = ":" Then Hours = Val(Left(strTime, 2)) Minutes = Val(Right(strTime, 2)) If Hours >= 0 And Hours <= 23 _ And Minutes >= 0 And Minutes <= 59 Then blnValid = True End If End If If Not blnValid Then MsgBox "يجب إدخال الوقت بالتنسيق (00:00)" & vbCrLf & _ "مثال: 08:30 أو 14:45", _ vbCritical, "تنسيق وقت خاطئ" Me.mdfo.SetFocus Exit Sub End If '========================== ' النموذج الهدف '========================== Set frmTarget = Forms!Form1.Form frmTarget!Horair = strTime '========================== ' التأكد من وجود وقت البداية '========================== If Trim(Nz(frmTarget!Horaire, "")) = "" Then MsgBox "أدخل التوقيت", vbExclamation Exit Sub End If '========================== ' حساب المدة '========================== strDuration = GetDuration(frmTarget!Horaire, frmTarget!Horair) 'تحويلها إلى دقائق Hours = Val(Split(strDuration, ":")(0)) Minutes = Val(Split(strDuration, ":")(1)) TotalMinutes = Hours * 60 + Minutes '========================== ' يجب أن تكون ساعة واحدة فقط '========================== If TotalMinutes <> 60 Then MsgBox "يوجد خطأ في التوقيت", vbCritical, "تنبيه" frmTarget!Horair = Null frmTarget!Time_Period = Null Exit Sub End If '========================== ' تخزين المدة '========================== frmTarget!Time_Period = strDuration DoCmd.Close acForm, Me.Name, acSaveNo Exit Sub ErrorHandler: MsgBox "خطأ: " & Err.Description, vbCritical End Sub

عمل جميل منتظرين باقي الابداع

السلام عليكم يوجد استعلام اسمه Query2 تعديل الكود الموجود في الاستعلام BB: IIf(IsNull([Hor1]);"أدخل التوقيت من";IIf(IsNull([Hora1]);"أدخل التوقيت الى";"تم حجز التوقيت")) عند حجز التوقيت من 0:00 التوقيت الى 0:00 يتم اظهار تم حجز التوقيت اريد عند حجز التوقيت 0:00 يظهر (( يوجد خطأ في التوقيت)) وعند حجز التوقيت اكثر من ساعة يظهر (( يوجد خطأ في التوقيت)) وعند حجز التوقيت اقل من ساعة يظهر (( يوجد خطأ في التوقيت)) وعند وجود الحقل فارغ تظهر (( أدخل التوقيت)) البرنامج التاريخ.rar

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

الله ينور ممكن تعمل لينا الاكود بالامثله علي الاكسل

الله ينور علي المجهود ممتاز وفكره الترحيب بالصوت حلوه وممكن الشرح لها وكيفيه عملها منتظرين المشروع بالكامل

وعليكم السلام ورحمه الله وبركاته اتفضل لعله يكون المطلوب جدول ورديات.xlsm

فعلا هذا هو حل مشكلة الملف . . . الف شكر لكم جميعا ولو انها متاخره كثيرا ولكن الرجاء قبول شكرى لكم

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

بارك الله فيك

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

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

ولا اجمل ... شكرا لكم

جائت متأخرة لكنها كحبة الكرز على رأس الجاتوه 😁👌 تم إضافة مشاركة الأستاذ أبو ناصر لقائمة المشاركات .. 🙂⭐ :: أبو ناصر - AbuNassir ::

استخدم برنامج البوربوينت، تستطيع تعديل حجم الشريحة بهذا الحجم، وايضًا يمكن طبع الشرائح مرة واحدة. حمل النموذج من المرفقات. ستيكر.pptx

بالانتظار اخى الكريم