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

انسى بالتوفيق اخى

Sub Test() Const sSheetName As String = "Report" Dim e, ws As Worksheet, f As Boolean, t1 As Double, t2 As Double, x As Long, y As Long, r As Long, iRow As Long, fRow As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("MIN") On Error Resume Next Application.DisplayAlerts = False ThisWorkbook.Worksheets(sSheetName).Delete Application.DisplayAlerts = True On Error GoTo 0 Sheets.Add(After:=Sheets(Sheets.Count)).Name = sSheetName With ThisWorkbook.Worksheets(sSheetName) .DisplayRightToLeft = True .Cells.Clear With .Cells .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With iRow = 1 For y = 2012 To Year(Date) fRow = iRow t1 = 0: t2 = 0: x = 0 ws.Range("C14").Value = y With .Cells(iRow, 1) .Value = y .Font.Bold = True .Interior.Color = RGB(219, 219, 219) End With For Each e In Array("16|30", "32|41", "43|52") x = x + 1 f = False For r = Val(Split(e, "|")(0)) To Val(Split(e, "|")(1)) If ws.Cells(r, "U").Value > 0 And ws.Cells(r, "U").Value <> Empty Then If f = False Then iRow = iRow + 1 If x = 2 Then iRow = iRow + 1 .Cells(iRow, 2).Value = ws.Range(IIf(x = 1, "D", "B") & Val(Split(e, "|")(0)) - 1).Value .Cells(iRow, 3).Resize(, 6).Value = ws.Range("P" & Val(Split(e, "|")(0)) - 1).Resize(, 6).Value .Cells(iRow, 2).Resize(, 7).Interior.Color = vbYellow f = True End If iRow = iRow + 1 .Cells(iRow, 2).Value = ws.Cells(r, IIf(x = 1, "D", "B")).Value .Cells(iRow, 3).Resize(, 6).Value = ws.Cells(r, "P").Resize(, 6).Value t1 = t1 + .Cells(iRow, "F").Value t2 = t2 + .Cells(iRow, "H").Value End If Next r iRow = iRow + 1 If x = 1 Then iRow = iRow - 1 Next e iRow = iRow + 1 .Cells(iRow, 2).Value = "Total" With .Cells(iRow, "F") .Value = t1 .Interior.Color = vbCyan End With With .Cells(iRow, "H") .Value = t2 .Interior.Color = vbCyan End With iRow = iRow + 2 With .Range(.Cells(fRow, 2), .Cells(iRow - 2, 8)) .Borders.Value = 1 .BorderAround Weight:=3 End With f = False Next y .Rows.RowHeight = 19 .Columns(1).ColumnWidth = 9 .Columns("B:H").AutoFit End With Application.ScreenUpdating = True End Sub

أخطاء بسيطة جدا تدل على محاولة تطبيق الكود بدون فهم متغيراته وكائناته إن شاء الله يكون هذا هو المطلوب Sub ColllectShets() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, x As Long Dim Arr, i As Long Set ws = Sheets("مجمع الصفوف") Application.ScreenUpdating = False ws.Range("C10:p10000").Clear For Each Sh In Sheets(Array("1", "2", "كي جي1")) x = WorksheetFunction.CountA(Sh.Range("a10:a" & Sh.Range("a" & Rows.Count).End(xlUp).Row)) Sh.Range("C10:p" & Sh.Range("a" & Rows.Count).End(xlUp).Row).Copy If LR < 9 Then LR = 9 Else LR = ws.Range("D" & Rows.Count).End(xlUp).Row End If ws.Range("C" & LR + 1).PasteSpecial xlPasteFormats ws.Range("C" & LR + 1).PasteSpecial xlPasteValues ws.Range("p" & LR + 1).Resize(x).Value = Sh.Name Application.CutCopyMode = False For i = 10 To ws.Range("d" & Rows.Count).End(xlUp).Row ws.Range("C" & i) = i - 9 Next i Next Sh Application.ScreenUpdating = True End Sub لاحظ استعمالك للعمود C للحصول على آخر صف بالرغم من فراغ العمود C لذلك تم استعمال العمود D بدلا منه بالتوفيق

بارك الله فيك استاذ وجزاك الله خيرا

ممكن تعمل قائمة بالاوامر التي تريدها عند الضغط على زر طباعة / معاينة تظهر هذه القائمة المنبثقة مثل الصور .... وتجد في موضوع الاستاذ @jjafferr الكثير من المهارات المطلوبة ::

عليكم السلام ورحمة الله وبركاته حسب فهمي للمطلوب يمكنك استخدام هذه المعادلة =IF(R7=300,N11*300,IF(N11<=5,N11*600,(5*600)+(N11-5)*300)) بالتوفيق

لازم نعمل فكشن ثاني خاص بحقل الاخطاء هذا جزء من طلبك ...والبقية انت اعملها لانها تحتاج تتبع الاخطاء وماشاء الله كود اخينا ابو جودي يزغلل العيون قاعدة بيانات موظفين - (3).rar

موضوعك ... ممكن دخلت عليه بشكل يومي ومع ذلك لم افهم هل تريد زر واحد للمعاينة والطباعة والغاء الامر ... هل هذا طلبك ولماذا الغاء الامر ... ماهي وظيفته ... ؟؟؟

مصدر الصف فى مربع التحرير والسرد عمودين العمود الاول Column(0) = (crn) و العمود الثانى وهو المطلوب Column(1) = (الجهة الداخلية الوارد منها)

جزاكم الله خيرا تمام ١٠٠٪

عليكم السلام ورحمة الله زبركاته يمكنك استعمال هذه المعادلة في C2 =IFERROR(IF(G2>INDEX($N$2:$N$5,MATCH(I2,$O$2:$O$5,0)),0,INDEX($N$2:$N$5,MATCH(I2,$O$2:$O$5,0))-G2),"") مع سحب المعادلة لأسفل بالتوفيق

شكراً جزيلا أ. محمد على هذا الرد الوافي والشرح الواضح..تمنياتي لك بالتوفيق والمزيد من التألق،،

إخوتي في الله؛ رُوّاد موقع أوفيسنا المُباركون؛ فيما يلي كتابٌٌ نافع؛ أرجو أن ننتفع به جميعًا. عُنوان الكتاب: إهداء ثواب العمل للميّت المُسلم. المؤلّف: أ.د. محمد بن فهد بن عبدالعزيز الفريح. من هُنــــــا. المصدر/ مكتبة صيد الفوائد. في أمان الله.

الله عليك يا استاذي مبرمج سابق تسلم ايديك اشكرك هو المطلوب

وعليكم السلام واياكم اخى الحمدلله انك وجدت ما تبحث عنه اتفضل اطلع ع الرابط التالى من اعداد مهندسنا العزيز محمد طاهر جزاه الله عنا كل خير https://officena.net/Tips/Access-Mask.htm والتالى لميكروسوفت https://support.microsoft.com/ar-sa/office/التحكّم-في-تنسيقات-إدخال-البيانات-بواسطة-أقنعة-الإدخال-e125997a-7791-49e5-8672-4a47832de8da بالتوفيق

ممتاز استاذ مجدى بارك الله فيك وزادك الله من فضله

تفضل هذا التعديل sa1.4.zip

السلام عليكم اهلا اخى ومهندسنا العزيز كل الادوات الموجوده لدى للاطلاع والافاده فى الحدود مع المحافظه ع حقوق الاخرين والحمد لله معنا اخواننا ينبهوننا اذا تجاوزنا الحد وذلك للمحافظه على حقوق الاخرين ونحمد الله اننا نتعلم منهم كل حسن وطيب وجزاهم الله عنا كل خير بارك الله فيك مهندسنا العزيز وجزاك الله كل خير الحمدلله بالتوفيق

بسيطة ان شاء الله اتفضل يا سيدى New Microsoft Access Database (2-1).accdb

انا بالخدمة ما مكنني الله

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

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

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

وعليكم السلام-تفضل Option Explicit Private IsArrow As Boolean Private Sub ComboBox1_Change() Dim i As Long If Not IsArrow Then With Me.ComboBox1 .List = Worksheets("Sheet1").Range("A4", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value .ListRows = Application.WorksheetFunction.Min(6, .ListCount) .DropDown If Len(.Text) Then For i = .ListCount - 1 To 0 Step -1 If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i Next .DropDown End If End With End If End Sub Private Sub ComboBox1_DropButtonClick() With Me.ComboBox1 .List = Worksheets("Sheet1").Range("A4", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value .ListRows = Application.WorksheetFunction.Min(6, .ListCount) .DropDown End With End Sub Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Debug.Print Time; "KeyDown"; KeyCode; ComboBox1.ListIndex; ComboBox1.ListCount, ComboBox1.Value IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown) If KeyCode = vbKeyReturn Then Me.ComboBox1.List = Worksheets("Sheet1").Range("A4", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value ElseIf KeyCode = vbKeyTab Then With Me.ComboBox1 If .ListIndex = -1 Then .Value = .List(0) Else .Value = .List(.ListIndex) End If End With KeyCode = vbKeyReturn End If End Sub القائمة بالكومبوبوكس1.xlsm

عمل رائع جزاك الله خير الثواب استاذ مجدى

Zakariadz Bms من فضلك تجنباُ لإهدار الوقت أتمنى وأرجو منكم سرعة الرد دائماً ولا تتأخر ,فهل يعقل ان أقوم بالرد عليك يوم الإثنين وترد عليا يوم الخميس ؟!!! لو ممكن تقوم بالنظر الى الملف وان لم يكن هذا هو المطلوب , فعليك بتوضيح المطلوب اكثر من ذلك مع وضع النتائج المطلوبة يدوياً وشكرا .. وأرجو سرعة الرد حتى يتم غلق المشاركة حساب الاجر الوحيد أوفيسنا1.xlsx

أحسنت استاذ ماجد بارك الله فيك

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

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

وعليكم السلام-اجعل المعادلة هكذا =SUMIFS(T_Op[المبلغ],T_Op[الحساب],"زبائن",T_Op[التاريخ],">"&$I$3) 1استفسار الشرطية متعددة الشروط مع التاريخ.xlsx

موضوع قيم بارك الله فيك وزادك الله من فضله

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

تفضل كان عليك بدء المشاركة بالتحية ... السلام عليكم , يمكنك استخدام هذه المعادلة ,كما تم عمل التنسيق الشرطى اللازم كما تريد اذا كان هناك اختلاف - كما تـــم ضبط الملف والغاء وحذف الخلايا المدمجة بالجدول (على الرغم ان هذا أتعبنى كثيراً الى ان تم على خير) فهذا يصعب من أعمال اى شيء على الإكسيل ..ورجاءاً لا تقوم بعمل اى خلايا مدمجة بعد ذلك فى ملفاتك , وذلك حتى لا تجعل الجميع يبتعد عن مساعدتك فى طلبك لأنه سيأخذ ويستغرق وقت طويل منهم =IF(OR(SUM(K16:N16)<>$O16,SUM(F16:J16)<>$O16,SUM(B16:E16)<>$O16),"هناك اختلاف","") 1OutPatientStatistic.xlsx

بسيطة وسهلة لا تفعل أكثر مما تراه بالصورة

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

وعليكم السلام-لك ما طلبت Salary Change1.xlsm

بارك الله فيك وزادك الله من فضله بالطبع هذه البرامج من البرامج المفيدة والنافعة والهامة والمطلوبة لعدد كبير جداً من الأعضاء ... جعله الله فى ميزان حسناتك ورحم الله والديك

وعليكم السلام-تم تغيير المعادلة بمعادلة أخرى أخفف منها وليست مصفوفة -تفضل =IFERROR(INDEX($A$2:$A$14,AGGREGATE(15,6,ROW($A$1:$A$14)/(MATCH($A$2:$A$14&$B$2:$B$14,$A$2:$A$14&$B$2:$B$14,0)=ROW($A$1:$A$14)),ROWS($2:2))),"") ترتيب التاريخ1.xlsx

ممتاز استاذ مجدى عمل ممتاز جعله الله فى ميزان حسناتك ورحم الله والديك

أكرمك الله وبارك الله فيك

أخي الكريم أنا استعملت في الكود أن اسم النموذج userform1 فإذا كان النموذج لديك له اسم مختلف يمكنك كتابة اسم النموذج ثم الوسيلة show فمثلا إذا كان النموذج لديك اسمه form1 يمكنك فتحه بعد المدة المحددة بالكود التالي form1.show وليس userform1.show أتمنى أن يكون الأمر واضحاً

لتحديد المدة التي يتم تنفيذ الإجراء بعدها نغير في هذا السطر من sub timer vartimer = Format(Now + TimeSerial(0, 2, 0), "hh:mm:ss") حيث أن الدالة timeserial تضيف على الوقت الحالي وأول رقم للساعات وثاني رقم للدقائق وثالث رقم للثواني ............... ولإظهار نموذج إسمه userform1 بعد انتهاء المدة المحددة نغير الكود داخل الإجراء Sub yahm() إلى userform1.show ليصبح Sub yahm() userform1.show end sub مع حذف الكود الخاص بحفظ الملف وإطفاء الجهاز

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

أخي الكريم بعد أن قمت برفع الأمان وفتحت ملفي ظهرت لك رسالة تخبرك أن الملف يحتوي على ماكروات ماذا فعلت مع هذه الرسالة؟؟!! ...... الصواب أن تمكن الماكرو حتى يعمل ويقوم بخفض الأمان بعد ذلك لاحظ النص الموجود في النموذج جرب وأخبرني بالنتيجة أخي الكريم

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

أخي الكريم لتخفيض أمان الأكسس برمجيا لجميع نسخ الأكسس ضع في حدث عند التحميل للنموذج الذي تفتح عليه قاعدة البيانات الكود التالي Private Sub Form_Load() If CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & "\Access\Security\" & IIf(Application.Version < 12, "Level", "VBAWarnings")) <> "1" Then CreateObject("WScript.Shell").RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & "\Access\Security\" & IIf(Application.Version < 12, "Level", "VBAWarnings"), "1", "REG_DWORD" End If End Sub ومرفق مثال على ذلك بصيغة 2010 و 2003 يرجى تجربته على أكثر من إصدار أنا جربته على 2010 فقط ولكن بفضل الله الفكرة صحيحة MasAccessSecurity.rar MasAcessSecurity_mdb.rar

بالنسبة لتغيير الاسم يمكنك الذهاب إلى لوحة التحكم ----> تعديل اسم الظهور ثم تكتب الاسم الذي تريده وكلمة المرور الحالية ........... وبالنسبة لموضوع العدد أنت الذي قررت أن يكون 30 وتسأل الآن ماذا إذا لم يجد 30 أعتقد أنه يجب مراجعة المطلوب بدقة حتى لا تتعب الناس معك وكل عام أنتم بخير

أخي الكريم كيماس ابا عمر بالنسبة لموضوع إرسال الموقع لتنبيهات على بريدك إذا رد أحد على الموضوع يجب تفعيلها أولا بالضغط على (متابعة هذا الموضوع) الموجودة أعلى يسار الموضوع أو بصورة افتراضية لكل المواضيع التي اشتركت فيها من خلال لوحة التحكم ---> خيارات التنبيهات ستجد جميع خيارات التنبيه عدّلها كما تشاء

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

رائع أخي يحياوي كل عام أنتم بخير ولمن يريد إغلاق الملف وعدم إطفاء الجهاز يضع رمز التعليق قبل السطر التالي Shell "shutdown -s -t 02", vbHide لأنه هو المسئول عن إطفاء الجهاز