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

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

اتفضل استاذنا الحبيب ابوالبراء اليك حلا متواضعا بسيطا بجانب ماقدمه الاساتذه تقبلوا منى تحياتى {=INDEX($A$1:$A$10;SMALL(IF(LARGE(LEN($A$1:$A$10);ROW($A1))=LEN($A$1:$A$10);ROW($A$1:$A$10);"");1))}

الســـــــــــــلام عليكم ورحمة الله تعالى وبركاته اولا انا اول مرة اشارك فى هذا القسم وهذا بسبب جهلى فى الاكسل ولكن اعجبنى العنوان فقررت الدخول من باب حب الاستطلاع ولكـــــــــــــــــــــــــــــــــن Module1 Option Explicit Public IdleTime As Date Private Sub DeleteAllVBA() 'NOTE: The Following Procedures Run Every 5 Seconds, So We Want Execution Time 'To Be As Short A Time As Possible So That They Doesn't Interfere Unduly With Normal 'Workbook Operation, So Delete All Comments, Indenting, And Blank Lines In These 'Three Procedures When Finished. '------------------------------------------------------------------------------------ With ThisWorkbook If Sheet1.[A1] = "123" And .BuiltinDocumentProperties("Comments") = "123" Then 'In This Case Both Passwords Are Entered Correctly, So 'The Timer And The Rest Of This Procedure Are Redundant Run "DisableTimer" Exit Sub Else If .VBProject.Protection = 0 Then 'Unlocked Run "DisableTimer" 'Use Late Binding So No GUID Reference Is Needed Dim Component As Object 'Delete All VBA For Each Component In .VBProject.VBComponents With Component.CodeModule .DeleteLines 1, .CountOfLines End With Next Component 'Save And Close To 'Fix' The Changes .Save MsgBox "Sorry! An Incorrect Password Was Entered - All VBA Code Deleted - Re-enter Password To Check...)" Workbooks.Open (.FullName) '< Open 2nd Instance Of Saved Book .Close '< Close The 1st Instance Else 'Restart The Timer If The Project's Locked Run "StartTimer" End If End If End With Exit Sub End Sub Private Sub StartTimer() 'This Procedure Interferes With Work In The VBE If Accidentally Set Running, 'So We Disable It So The Developer Can Work There Uninterrupted... If Sheet1.[A1] = "123" And ThisWorkbook.BuiltinDocumentProperties("Comments") = "123" Then Exit Sub '<< Set Your Own Idle Time Below >> IdleTime = Now + TimeValue("00:00:05") Application.OnTime IdleTime, "DeleteAllVBA" End Sub Private Sub DisableTimer() On Error Resume Next Application.OnTime EarliestTime:=IdleTime, Procedure:="DeleteAllVBA", Schedule:=False End Sub ThisWorkbook Option Explicit Private Sub Workbook_Open() 'Test To Ensure Access Is Allowed (For 2002 Onward) If Application.Version > 9 Then Dim VisualBasicProject As Object On Error Resume Next Set VisualBasicProject = ActiveWorkbook.VBProject If Not Err.Number = 0 Then MsgBox "Your Current Security Settings Do Not Allow The Code In This Workbook " & vbNewLine & _ " To Work As Designed And You Will Get Some Error Messages." & vbNewLine & vbNewLine & _ "To Allow The Code To Function Correctly And Without Errors You Need" & vbNewLine & _ " To Change Your Security Setting As Follows:" & vbNewLine & vbNewLine & _ " 1. Select Tools - Macro - Security." & vbNewLine & _ " 2. Click The 'Trusted Sources' Tab" & vbNewLine & _ " 3. Place A Checkmark Next To 'Trust Access To Visual Basic Project.'" & vbNewLine & _ " 4. Save - Then Close And Re-open The Workbook", vbCritical End If End If 'Disable The Esc Key And Start Timer Application.EnableCancelKey = xlDisabled Run "StartTimer" End Sub 'All Subs And Event Procedures Should Have Run "DisableTimer" At The Head 'Of The Code And Run "StartTimer" At The End As Per The Examples Below. Private Sub Workbook_SheetCalculate(ByVal Sh As Object) Run "DisableTimer" Run "StartTimer" End Sub Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Run "DisableTimer" Run "StartTimer" End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range) Run "DisableTimer" Run "StartTimer" End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Run "DisableTimer" Run "StartTimer" End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Run "DisableTimer" End Sub

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

حبيبي ابو البراء بس الكود يدوب يسلك حال مهما عملت الحماية ضايعة تلت اربع الحمايات بتتحل بايقاف تشغيل الماكرو من مركز التوثيق سيبك انت من الحماية شكلك اتعديت من الفلاحجي بتعمل قرشين اهو

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

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

موعظـــــــــــــــــــــــــــــــــــــــــة أعطى أب لإبنه يوماً كيساً مليئاً بالمسامير وقال له: ( يا بني كلما اهنت شخص أو ضربت شخص أو جرحت شخص اذهب إلى سور الحديقة واطرق فيه مسماراً ) لم يفهم ذلك الولد لماذا طلب والده منه ذلك ولكنه امتثل لأمر والده وأصبح كلما يظلم أحداً أو يصرخ بوجه أحد أو يجرح أحداً يطرق مسماراً في ذلك السور ومع مرور الأيام أصبح الولد أكثر تحكماً في نفسه وانخفض عدد المسامير التي يطرقها كل يوم في السور إلى أن وصل اليوم الذي لم يطرق فيه ذلك الولد أي مسمار في السور فطار الولد من شدة الفرح وذهب إلى والده واخبره بذلك قال له والده: ( أحسنت يا بني أنت الآن شخص تتحكم في نفسك وفي أعصابك ولكن مهمتك لم تنته بعد ) استغرب الولد وقال: وماذا افعل بعد ذلك يا أبي ؟؟؟ قال الأب: ( كل يوم يمضي ولا تزعج أو تجرح أو تظلم فيه أحداً انزع مسماراً من ذلك السور مضت الأيام واستمر الولد في نزع المسامير في كل يوم لا يؤذي فيه أحداً إلى أن وصل اليوم الذي نزع فيه الولد آخر مسمار في ذلك السور فطار الولد من الفرح وذهب إلى والده ليخبره بذلك وعندما أخبره أخذ الأب ابنه إلى السور وقال أحسنت يا بني فأنت لم تصبح شخص متحكم في أعصابك فقط ولكنك أصبحت شخص طيب ولا تؤذي أحداً ولكن انظر إلى الثقوب في السور التي خلفتها تلك المسامير ……… لقد استطعت يا بني أن تنزع المسامير التي طرقتها ولكنك لا تستطيع محو تلك الثقوب التي تركتها المسامير !!! وكذلك هم البشر يا بني عندما تجرح أحدهم فأنت تطرق مسماراً في قلبه قد تستطيع أن تعتذر وتنزع ذلك المسمار ولكنك لن تنزع أثره وسيبقى ذكرى مؤلمة في حياة ذلك الشخص . لذلك يا بني لا تجرح الآخرين أو تؤذيهم بكلماتك فإنك لن تستطيع محو ذلك الجرح إلى الأبد ..

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

جزاكم الله خيرا

السلام عليكم ورحمة الله وبركاته إخواني الأحباب في المنتدى الأغر .. أقدم لكم كود في منتهى الروعة ، يقوم بعمل خريطة (ليست الخريطة التي في مخيلتكم .. أنا معلم لغة إنجليزية ولست معلم دراسات اجتماعية) الكود يعتمد على إنشاء ورقة عمل جديدة .. لبدء العمل فيها بناءً على ورقة العمل النشطة التي يتم تنفيذ الكود بها .. ورقة العمل الجديدة تحتوي على خلايا ملونة وداخلها رموز .. للتعرف على القيم الرقمية والنصوص والمعادلات الموجودة داخل ورقة العمل النشطة .. 'وتلوينها باللون الأصفر[N]يتم ترميز الخلايا التي تحتوي على قيم رقمية بالرمز ' وتلوينها باللون الأخضر[T]يتم ترميز الخلايا التي تحتوي على قيم نصية بالرمز 'وتلوينها باللون الأحمر[F]بالرمز[Formulas]يتم ترميز الخلايا التي تحتوي على معادلات ويوضع الكود داخل موديول بهذا الشكل Sub QuickMap() If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub 'Create object variables for cell subsets إنشاء متغيرات للكائنات التي تمثل مجموعات الخلايا On Error Resume Next Set FormulaCells = Range("A1").SpecialCells _ (xlFormulas, xlNumbers + xlTextValues + xlLogical) Set TextCells = Range("A1").SpecialCells(xlConstants, xlTextValues) Set NumberCells = Range("A1").SpecialCells(xlConstants, xlNumbers) On Error GoTo 0 'Add a new sheet and format it إنشاء ورقة عمل جديدة وعمل تنسيق لها Sheets.Add With Cells .ColumnWidth = 2 .Font.Size = 8 .HorizontalAlignment = xlCenter End With Application.ScreenUpdating = False 'Do the formula cells التعامل مع الخلايا التي تحتوي على معادلات If Not IsEmpty(FormulaCells) Then For Each Area In FormulaCells.Areas With ActiveSheet.Range(Area.Address) .Value = "F" .Interior.ColorIndex = 3 End With Next Area End If 'Do the text cells التعامل مع الخلايا التي تحتوي على نصوص If Not IsEmpty(TextCells) Then For Each Area In TextCells.Areas With ActiveSheet.Range(Area.Address) .Value = "T" .Interior.ColorIndex = 4 End With Next Area End If 'Do the numeric cells التعامل مع الخلايا التي تحتوي على قيم رقمية If Not IsEmpty(NumberCells) Then For Each Area In NumberCells.Areas With ActiveSheet.Range(Area.Address) .Value = "N" .Interior.ColorIndex = 6 End With Next Area End If End Sub فائدة الكود تكمن في إمكانية التعرف على الأخطاء التي يمكن أن تتواجد في ورقة العمل .. . لنفترض أن لديك عمود به معادلات ، وعن طريق الخطأ تم إدخال قيم ثابتة في هذا العمود .. باستخدامك لهذا الكود سيكون بإمكانك وضع يدك على الخلايا التي بها قيم ثابتة في العمود الذي يحتوي على معادلات .. أتمنى أن ينال الملف المرفق رضاكم ، وأن تستفيدوا منه إن شاء الله عزوجل تقبلوا تحياتي القلبية ، ودمتم على طاعة الله Quick Map VBA.rar

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

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

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

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

أخي الكريم سعد عابد مشكور على مرورك الكريم بالموضوع وجزاك الله خيراً وعليكم السلام أخي الحبيب أبو يوسف بارك الله فيك وجزيت خيراً على مرورك العطر بالموضوع ، والمميز هو مرروك أخي الغالي

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

بعد اذن اخى الحبيب كرار صبري _ أبو جنى جرب هذا الحل ووافنى بالنتيجة يا استاذ Hadi22 Database5_update.rar

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

تفضل ... Database5.rar

السلام عليكم إن صح عملي بنصيحتك يكون الكود على الشكل التالي: "والله أعلم" Sub SortByLEN() Application.ScreenUpdating = False With Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row) .FormulaR1C1 = "=LEN(RC[-1])" Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row).Sort Key1:=Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row), Order1:=xlDescending, Header:=xlNo .ClearContents End With Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله وبركاته أخي الحبيب أبو البراء وهذا كود آخر بحثت عنه وأضمه إلى باقتكم العطرة لكنني أود مراجعة آخر نقطة وقفت عنها لأنني لم أدركها ولم أستطع تطبيقها ... Sub kTest() Dim Rng As Range Application.ScreenUpdating = 0 Columns(1).Insert: Rows(1).Insert [a1] = "temp": [b1] = "texts" Set Rng = Range("a1", Range("b" & Rows.Count).End(xlUp)) With Rng .Offset(1).Resize(.Rows.Count - 1, 1).Formula = "=len(b2)" .Sort .Cells(2, 1), xlDescending, Header:=xlNo .Columns(1).Delete .Rows(1).Delete End With Application.ScreenUpdating = 1 End Sub

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

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

الأخت الفاضلة رشا .. يحبذ دائماً طرح أي طلبات جديدة في موضوع مستقل .. عموماً إليكي الكود التالي عله يفي بالغرض .. يقوم الكود بنسخ الجدول الأساسي ثم استخراج القيم التي في كلا الجدولين (الجدول الأول والثاني) .. الكود بسيط جداً ويمكن فهمه بسهولة Sub Test() Dim Sh As Worksheet: Set Sh = Sheets("Sheet1") Dim Lr As Long: Lr = Sh.Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False With Sh .Columns("N").Resize(, 5).Clear .Range("A2:C" & Lr).Copy .Range("N2") .Range("Q2:R2").Value = Array("Total Issued1", "Total Issued2") .Columns("P").Copy: .Columns("Q:R").PasteSpecial Paste:=xlPasteFormats .Columns("N").Resize(, 5).AutoFit With .Range("Q3:Q" & Lr) .Formula = "=IFERROR(INDEX(G:G,MATCH(O3,F:F,0)),"""")" .Value = .Value End With With .Range("R3:R" & Lr) .Formula = "=IFERROR(INDEX(K:K,MATCH(O3,J:J,0)),"""")" .Value = .Value End With End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub أرجو أن يكون المطلوب ويفي بالغرض .. Compare Two Tables With Main Table YasserKhalil.rar

بارك الله فيك وفى أهلك أخى الفاضل الكريم أبو يوسف

قال الحسن البصري رحمه الله: “قرأت في تسعين موضعا من القرآن أن الله قدر الأرزاق و ضمنها لخلقه ، وقرأت في موضع واحد : الشيطان يعدكم الفقر . فشككنا في قول الصادق في تسعين موضعاً.. و صدقنا قول الكاذب في موضع واحد . "لا يؤخر الله أمراً .. إلا لخير ولايحرمك أمراً .. إلا لخير ،ولا يبكيك اليوم .. إلا لخير ، ولا ينزل عليك بلاء .. إلا لخير ، لذا لاتحزن .. فكل الأمور خير ..فالحمدلله الذي بيده الخير وهو على كل شيء قدير ... ثم تذكر :أن سعَآدةُ آلٱنسآن . في :ٱلشّگرُ عَلى ٱلعَطيّة . . وٱلصَبر عَلى ٱلبليّة .. و ٱلٱسّتغفآر عند ٱلخَطيئَة . . ٱسٱل ٱلله ٱن يُسعدْ قُلوبگم بما تتمنون في مايرضي الله .. أسعدكم الله بكل خير

السلام عليكم ورحمة الله وبركاته جزاكم الله خيراً أخي الحبيب أبو جودي على حسن ظنك بنا ...نِعْمَ الصاحب الساحب إلى الرضى والقبول إن شاء الله تعالى. أرجو أن يكون لنا جميعاً حظاً وسعداً في الصحبة الطيبة ...وأنا أيضاً وكما قال الإمام الشافعي رحمه الله أحب الصالحين ولست منهم -"أرجو أن نكون من الصالحين الناصحين"- لعلي أرتجي منهم يوم القيامة شفاعة... وفرق شاسع بين حامل المسك ونافخ الكير والسلام عليكم ورحمة الله وبركاته

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

دورة برنامج Excel فيديو وصوت ( عربي )

الاخوه فى هذا الصرح العلمى الكبير اعتذر عن قلة تواجدى فى الاونه الاخيره ولكن يعلم الله انى مشغول جدا هذه الايام اسالكم الدعاء لى بالتوفيق والسداد اليوم بأقدم لكم شرح مبسط عن النسخ والقص أو الترحيل بواسطة Destination وهى تعنى هدف الوصول أو مكان الوصول أو المكان المقصود هنعرف 1 - أزاى نعمل ده بدون اكواد من خلال التعامل مع الشيت مباشرة 2- أزاى نعمل ده بالاكواد نبدأ بسم الله عايزك تفتح شيت اكسيل وتكتب فى الخليه A1 مثلا اى شئ مثلا اكتب " اوفيسنا " المطلوب بعد ما تكتب فى الخليه A1 نقوم بنسخها الى اى خليه اخرى طبعا زى ما حضراتكم عارفين بيكون من خلال تحديد الخليه المطلوب نسخها وهى A1 تم نعمل Ctrl+C ونذهب الى المكان اللى احنا عايزين نقوم بعملية لصق الخليه بها وليكن الخلية D1 ثم نعمل Ctrl+V وفى طريقه تانية وهى الوقوف على الخليه A1 وكليك يمين بالماوس واختيار نسخ ثم تحديد الخليه D1 وكليك يمين ونعمل لصق لكن اليوم هنعمل عملية النسخ بطريقه Destination طيب ازاى ؟؟؟ حدد الخليه A1 ثم حرك الماوس الى اى ضلع من اضلاع الخليه ستجد فى سهم مثل هذا السهم دا صوره مكبره منه عندما يظهر هذا السهم على ضلع من اضلاع الخلية اضغط من الكيبورد على زر Ctrl ومع الاستمرار بالضغط على الزر اضغط على زر الماوس الايسر واسحب الماوس الى الخليه D1 مكان اللصق اللى احنا عايزينه طيب ده بالنسبه لعملية النسخ طيب عملية القص ؟؟ الطريقه الاولى تحديد الخليه المطلوب قصها وهى A1 تم نعمل Ctrl + X ونذهب الى المكان اللى احنا عايزين نقوم بعملية لصق الخليه بها وليكن الخلية D1 ثم نعمل Ctrl+V الطريقه التانية وهى الوقوف على الخليه A1 وكليك يمين بالماوس واختيار قص ثم تحديد الخليه D1 وكليك يمين ونعمل لصق الطريقه الثالثه اللى هى اساس موضوعنا هنعمل عملية القص بطريقه Destination طيب ازاى ؟؟؟ حدد الخليه A1 ثم حرك الماوس الى اى ضلع من اضلاع الخليه ستجد فى سهم عند ظهوره يمكنك الضغط على زر الماوس الايسر والسحب الى المكان المراد اللصق فيه الخلاصه الطريقه عملية النسخ عملية القص 1- من خلال الكيبور اضغط Ctrl+C ثم انتقل الى الخلية اضغط Ctrl+X ثم انتقل الى الخلية المراد النسخ بها واعمل Ctrl+V المراد اللصق بها واعمل Ctrl+V --------------------------------------------------------------------------------------------------------------------------------------------- 2- من خلال الماوس قم بتحديد الخلية وكليك يمين بالماوس قم بتحديد الخلية وكليك يمين بالماوس واختار نسخ ثم انتقل الى الخليه المراد واختار قص ثم انتقل الى الخليه المراد اللصق بها واعمل كليك يمين بالماوس اللصق بها واعمل كليك يمين بالماوس واختار لصق واختار لصق --------------------------------------------------------------------------------------------------------------------------------------------- 3-Destination حدد الخلية المطلوب نسخها واتجه بالماوس حدد الخلية المطلوب نسخها واتجه بالماوس ( المكان المقصود) الى اى ضلع من اضلاع الخليه هيظهر سهم الى اى ضلع من اضلاع الخليه هيظهر سهم اضغط من الكيبورد على زر Ctrl ومع الاستمرار اسحب الماوس الى المكان المطلوب اللصق به بالضغط اسحب الماوس الى المكان المطلوب اللصق به ----------------------------------------------------------------------------------------------------------------------------------------------------- طيب ازاى نعمل الطريقه رقم 3 Destination ( المكان المقصود) بالاكواد Sub Alsaqer1() Range("A1").Copy Destination:=Range("d1") End Sub طبعا السطر الاول والثالث معروف وهو الاعلان عن بداية الكود ونهايته السطر اللى فى المنتصف بقى هو اللى هنوضحه كتبت اسم الخلية A1 المطلوب نسخها من خلال الخاصيه Range كالتالى ("Range("A1 وبعدين كتبت . اللى هى الضغط على حرف ز بالعربى من الكيبور ثم Copy وتعنى نسخ وبعدين مسافه وكتبة Destination متبوعه =: ثم الخلية المراد اللصق بها ("Range("D1 طيب الكود هيكون ازاى لو عايز اعمل قص وليس نسخ بسيطه جدا نفس الكود مع استبدال Copy Sub Alsaqer2() Range("A1").Cut Destination:=Range("d1") End Sub طيب الكلام كله عن نسخ او قص خليه واحده ماذا لو كان المطلوب نسخ نطاق من الخلايا مثلا من A1:C5 الى الخلايا H1:J5 اولا من خلال شيت الاكسل حدد الخلايا من A1:C5 وحرك الماوس الى اى ضلع من اضلاع التحديد سيظهر امامك السهم عند ظهوره اضغط على زر Ctrl ومع الاستمرار بالضغط حرك الماوس الى الى الخلية H1 ستجد تم نسخ الخلايا طيب ولو عملية القص هيكون نفس الخطوات ولكن بدون الضغط على زر Ctrl يعنى عند ظهور السهم اسحب الماوس الى الخليه H1 طيب ومن خلال الكود لو نسخ شاهد الكود Sub Alsaqer3() Range("A1:C5").Copy Destination:=Range("h1") End Sub نفس الاكواد السابقه الفرق فقط هو بدل ("Range("A1 جعلتها ("Range("A1:C5 ولو قص الخلايا يبقى الكود كالتالى استبدل Copy بــ Cut Sub Alsaqer4() Range("A1:C5").Cut Destination:=Range("h1") End Sub ماذا لو كان المطلوب نسخ الخلايا الى شيت اخر شاهد الكود نفس السابق ولاحظ انت الفرق Sub Alsaqer5() Range("A1:C5").Cut Destination:=Sheet2.Range("h1") End Sub استبدلت ("Range("h1 بــ ("Sheet2.Range("h1 لو احنا عايزين ننسخ عمود A كله مثلا الى العمود F طبعا من خلال الشيت يبقى تحدد العمود كله واذهب الى اى ضلع من العمود هيظهر السهم اضغط على زر Ctrl ومع استمرار الضغط اسحب الماوس الى العمود المطلوب وهو F ولو قص يبقى نفس الخطوات بدون الضغط على زر Ctrl ولو عايزين نعمله بالكود شاهد الكود Sub Alsaqer6() Columns("a:a").Copy Destination:=Columns("f:f") End Sub ------ ماذا لو كان عندى نطاق متغير مثلا من جدول من العمود A الى C ولكن عدد صفوف الادخال غير محدد فى زياده او نقصان فى الحاله دى هعمل سطر لتحديد اخر صف به بيانات فى العمود A شاهد الكود Sub Alsaqer7() lr = Cells(Rows.Count, "A").End(xlUp).Row Range("A1:C" & lr).Copy Destination:=Range("h1") End Sub واخيرا الفائده من هذه الطريقه هى افضل بالاكواد نظرا لسرعه تنفيذ الكود وبساطه كتابته وفهمه كدا انا خصلت كل الامثله باقى انك بس تجرب بنفسك اسال الله تعالى لى ولكم التوفيق والسداد تقبلوا تحياتى

انا اسف ما اخدتش بالى ان فى كلمة سر بس ولا يهمك اهى sigmapc100 والطريقه للتفعيل هى كالتالى ادخل على قائمة help اختار ريجيسترى الصق الكود ثم نكست تم التفعيل ومبروك بالتوفيق اخوانى

أخي الحبيب عبد الفتاح لكم اشتقنا إليك أيضاً .. واشتقنا لمشاركاتك في المنتدى عوداً حميداً ولعلنا نرى ابداعاتك ها هنا .. كفاية أكسس وتعالى شوية للإكسيل

السّلام عليكم و رحمة الله و بركاته بارك الله فيك و لك أخي الغالي " ياسر خليل أبو البراء " على الملف المهم و الرّائع و الجديد في قائمة الابداعات ننتظر الأكواد لأنّني دخلت لمحرر الأكواد و لم أجد شيئًا .. و هذا هو أساس الملف فئق إحتراماتي

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

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

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

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

وجرب هذا الكود ايضا CurrentDb.Execute ("DELETE DISTINCTROW leave.* FROM leave INNER JOIN record ON leave.d = record.Date") كلام صحيح ، وهذا ينطبق على الحقل name كذلك ولكن للتخلص من هذه المشكلة ، ضع الحقل بين قوسين مربعين ، بهذه الطريقة يعرف الاكسس انه حقل docmd.runsql "DELETE leave.* FROM leave WHERE d IN (SELECT [date] FROM record)" جعفر

الافضل فى عمل شيت منفصل يمكن بنفس المعادله مع بعض التغييرات البسيطه

بارك لك الله فى " جنى " ورزقك برها ورزقها الهدى والتقى والعفاف والغنى والذرية الصالحة ورزقكما ومن تحبون شربة هنيئة مريئة من يد نبينا وحبينا سيدنا محمد صلى الله عليه وسلم شربة لا ظما بعدها ابدا حياكم الله اخى الحبيب ومرحبا بك وبكل اخواننا الكرام من العراق بلدنا الحبيب نسأل الله ان يصلح حاله وبلادنا وبلاد المسلمين

تفضل وهذا هو كود التأكد: 'check if this medicine is already in the prescription for this patient myCriteria = "[File_No] = '" & Forms!frm_Patient_Drugs!cmb_Patient_Name & "'" myCriteria = myCriteria & " And [Visit_Date] = #" & Forms!frm_Patient_Drugs!iDate & "#" myCriteria = myCriteria & " And [DoseID] = " & Me.ListDosing.Column(7) Is_It_Used = DCount("*", "tbl_Prescription", myCriteria) If Is_It_Used > 0 Then MsgBox "This medicine is already in the Prescription" Exit Sub End If جعفر 298.3.Medication.accdb.zip

أخي الحبيب أبو يوسف نعم باستخدام خاصية ScreenUpdating قبل التنفيذ تلغي التحديث وبعدها يمكنك تفعيله .. وعلى فكرة حتى لو لم تضف سطر لإعادة التحديث لا يؤثر في شيء حيث تعود الأمور إلى طبيعتها بعد انتهاء عمل الكود أي يمكن فقط استخدام سطر واحد لالغاء التحديث ، ولكن من الباب الجمالي توضع في البداية والنهاية بالنسبة للنطاق الديناميكي الموضوع في غاية السهولة .. فقط اتبع نصيحتي وأنت تعرف كيفية عمل ذلك: النطاق المستخدم هو A1:B10 المطلوب : استبدال الرقم 10 ليصبح رقم آخر صف به بيانات في العمود الأول (اللي هو أساس الشغل بتاعنا في المثال) استخدم الجملة دي مكان رقم 10 Cells(Rows.Count, "A").End(xlUp).Row يبقى المطلوب تعمله تشيل رقم 10 وبس ..لا تمس التنصيص الموجود .. ولا تمس قوس الإغلاق وبعد علامة التنصيص وقبل قوس الإغلاق تضع مسافة بالمسطر ثم علامة & اللي بتيجي من خلال الضغط على Alt + 7 ثم مسافة ... ثم تضع الجملة السحرية اللي أشرت إليها وبس خلاص جرب الكود بإضافة بيانات جديدة للتأكد من فعالية الإضافة .. وبكدا تقدر تتعامل مع النطاق بشكل ديناميكي الأخ الحبيب رمهان اللي يعمل خير ميشورش .. هات ما عندك .. أثري الموضوع بإبداعاتك الأخ الغالي الجموعي بارك الله فيك وجزاك الله خيراً على مرورك العطر بالموضوع وعلى الحل المقدم .. سأطلع عليه ولو فيه أي تعليق هبلغك بيه ... أنا بعمل عملية تشريح لكل كود وكل حل يقدم خلي بالك .. تقبلوا جميعاً تحياتي

هل يتم ذلك بإيقاف تحديث الشاشة ثم إعادة تحديثها بعد تنفيذ الكود ...يرجى الإفادة. وأما المدى الديناميكي ...أكيد بحاجة دراسة.

بارك الله فيك اخي الغالي ابا جودي وجعله الله في ميزان اعمالكم الطيبة باذن الله

اخى حسام شروحاتك جميلة شكرا لك

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

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

السلام عليكم<br>لك التجلة والتحية أستاذي الفاضل ياسر وأنت أيضا لك معزة ومكانة خاصة في صميم الفؤاد<br>لن أنساك ما حييت<br>

الاسم : محمد طاهر سنة الميلاد : 1968 م المهنة : مهندس مدني و أعمل فى مجال إدارة المشاريع الهندسية التعليم : بكارولويس هندسة مدنية 1991 - هندسة القاهرة ماجيستير إدارة مشروعات 1998 - هندسة القاهرة PMP 2008 RMP 2012 MVP 2010-2013 الحالة الاجتماعية : متزوج و رزقني الله ب 4 أطفال بلد الجنسية / بلد الاقامة : مصر / الامارات أقسام الاهتمام فى المنتدي : كل الأقسام - و بالذات الأكسيس و الإكسيل معلومات أخري : أحب الأكسس و أنشأت تطبيقات مختلفة له ، و أيضا أحب جدا الاكسيل و استخدام ال vba به . تتركز خبرتي فى مجال ادارة المشاريع عموما و مشاريع التشييد بصفة خاصة، و لدى خبرة عملية فى هذا المجال من حيث التطبيق و التدريب. أجيد إستخدام برامج ادارة المشروعات بالاضافة الي بعض البرامج الهندسبة و أستخدم بعض برامج الرسم و الجرافيك بصورة متوسطة. و لدي دراية بسيطة بتصميم الويب و لغاته . خبرتي فى المنتديات : عضو شرف و مشرف قسمي الأكسس و الأوفيس ( سابقا ) و مراقب سابق فى الفريق العربي للبرمجة و إفتتحت هذا الموقع رسميا فى فى الثاني من جمادي الأولي 1424 هـ الموافق أول يوليو 2003 مـ