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

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

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

استاذ عبد الرحمن كما طلبت حضرتك تم تحوبله للعربى أتمنى أن أكون قد وفقت فى عملى هذا لعله ما تطلب وشكرا New-Userform-Arabic.rar نتشارك كلنا بمساعدتكم معنا . شكرا لمرور حضرتك الاستاذ / أبو أنس الحمد لله أنه نال اعجاب حضرتك ان شاء الله واحيانا هدور تانى ولو لقيت حاجه تانية ان شاء الله هرفعها للمنتدى أسعدنى وشرفنى مرورك الكريم

أساتذتى الكبار أخوتى وأخواتى فى منتدى أوفيسنا أنا فخور انى أحد أعضاء المنتدى الكريم ده دائما ما نجد ضالتنا فيه لقيت الملف ده على موقع أجنبى وبصراحه عجبنى وحبيت أشارك بيه أحلى طاقم عمل فى المنتدى الى أن يتم شرحه وتفكيكه من عباقرة المنتدى مرفق ومنتظر اراءكم يارب يعجبكم New-Userform-.rar

زين شاشة برنامجك بعلم دولتك واجعلة يرفرفر خفاقا" مرفق مثال بسيط flags.rar

مجموعة اكواد اعجبتنى الكود الاول : تحية منى لاساتذتى بالمنتدى الرائع Sub Elsiad() ' ' Elsiad ماكرو ' الماكرو مسجل ‎28/06/2013 بواسطة ‎Basim Magdy Range("j1").Select ActiveCell.FormulaR1C1 = "بسم الله الرحمن الرحيم" Range("j2").Select ActiveCell.FormulaR1C1 = "تحياتى لكل اساتذتى بمنتديات أوفيسنا" Range("j3").Select ActiveCell.FormulaR1C1 = "الاستاذ / عبد الله باقشير" Range("j4").Select ActiveCell.FormulaR1C1 = "الاستاذ / أحمد فضيلة" Range("j5").Select ActiveCell.FormulaR1C1 = "الاستاذ / رجب جاويش" Range("j6").Select ActiveCell.FormulaR1C1 = "الاستاذ / حماده عمر" Range("j7").Select ActiveCell.FormulaR1C1 = "الاستاذ / هانى عدلى " Range("j8").Select ActiveCell.FormulaR1C1 = "الاستاذ / جمال عبد السميع " Range("j9").Select ActiveCell.FormulaR1C1 = "الاستاذ / احمد عبد الناصر " Range("j10").Select ActiveCell.FormulaR1C1 = "الاستاذ / شوقى ربيع " Range("j11").Select ActiveCell.FormulaR1C1 = "الاستاذ / جمال دغيدى " Range("j12").Select ActiveCell.FormulaR1C1 = "الاستاذ / طارق محمود " Range("j13").Select ActiveCell.FormulaR1C1 = "الاستاذ / ضاحى الغريب " Range("j14").Select ActiveCell.FormulaR1C1 = "الاستاذ / عبد الله المجرب " Range("j15").Select ActiveCell.FormulaR1C1 = "الاستاذ / سعيد بيرم " Range("j16").Select End Sub الكود الثانى : دعاء وحصن جميل Sub Hellomsg() donkeyain: Msg = "[ حصن لوقاية الانسان من شياطين الانس والجان ] " Ans = MsgBox(Msg, vbYesNo) If Ans = vbNo Then MsgBox "هل تود الذهاب الى الدعاء" GoTo donkeyain Else MsgBox "تحصنت بذى العزة والجبروت واعتصمت برب الملكوت وتوكلت على الحى الذى لا يموت & اصرف عنا الأذي انك على كل شئ قدير " End If End Sub الكود الثالث : ترحيل بيانات Sub sRange_Move() Sheets("ورقة2").Range("A9:c12").ClearContents Sheets("ورقة2").Range("a9:c12").ClearContents Sheets("ورقة2").Range("a9:c12").Value = Sheets("ورقة1").Range("A9:c12").Value End Sub الكود الرابع : جمع رقمين او اكثر Sub AddEmUp() Sum = 50 + 170 + 30 MsgBox "النتيجة = " & Sum End Sub الكود الخامس : حفظ تلقائى للبيانات فى ملف اكسل دون الضغط على ايقونة الحفظ ويوضع الكود فى WorkBook Private Sub Workbook_BeforeClose(Cancel As Boolean) Application.DisplayAlerts = False ThisWorkbook.Save Application.Quit End Sub ومرفق ملف اكسل به تطبيقات لهذه المجموعة من الاكواد

فقط استعمل هذه المغادلة =SUMIF($D$5:$D$20,"<0",$D$5:$D$20)

جرب هذا الملف عدم اظهار المكرر salim.rar

تكملة لموضوع جعل النص بشكل رأسى الذى بدأه أخى الحبيب / ياسر خليل قررت اضافة فكره أخرى بالاضافة الى جعل النص بشكل رأسى وهذه الفكرة إهداء إلى أخى الحبيب ياسر خليل Option Explicit Private Sub CommandButton1_Click() Dim T1 As String, TT1 As String Dim T2 As String, TT2 As String Dim N As Byte, w As Single, Temp Dim i As Integer, ii As Integer '================================== TT1 = "YASSER KHALIL" TT2 = "ياسر خليل" N = 0: i = 1: ii = 1 Do While N < Len(TT1) T1 = T1 & Mid(TT1, i, 1) & Chr(13) T2 = T2 & Mid(TT2, i, 1) & Chr(13) i = i + 1: ii = ii + 1 Label1.Caption = T1 Label3.Caption = T2 w = 0.2 Temp = Timer Do While Timer < Temp + w DoEvents Loop N = N + 1 Loop End Sub اهداء الى أخى الحبيب ياسر خليل.rar

السلام عليكم أخي الطيب الحبيب برنامج رائع جزاكم الله خيراً وجعله بموازين حسناتكم...آمين والسلام عليكم.

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

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

السلام عليكم ورحمة الله وبركاته أسعد الله صباحكم بكل خير اللهم أنت ربي لا إله إلا أنت، خلقتني وأنا عبدك وأنا على عهدك ووعدك ما استطعت، أعوذ بك من شر ما صنعت، أبوء لك بنعمتك علي وأبوء بذنبي فاغفر لي فإنه لا يغفر الذنوب إلا أنت رَبَّنَا إِنَّنَا آمَنَّا فَاغْفِرْ لَنَا ذُنُوبَنَا وَقِنَا عَذَابَ النَّارِ

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

أخي الكريم أرسلان ننتظر منك تغيير اسم الظهور للغة العربية بعد إذن أخي وحبيبي قنديل الصياد سأقوم بعمل ملفات مرفقة للأكواد الموجودة في الموضوع كل كود في ملف مرفق منفصل ليستفيد منه الجميع ..حيث لاحظت أن الملف المرفق الاستفادة منه أفضل من الأكواد بدون ملفات مرفقة الملف الأول : الكود الأول في المشاركة الأولى (تم التعديل بما يتناسب مع عدم استخدام كلمة Select التي تبطيء من عمل الكود) Sub Officena() Range("J1").FormulaR1C1 = "بسم الله الرحمن الرحيم" Range("J2").FormulaR1C1 = "تحياتى لكل أساتذتي بمنتديات أوفيسنا" Range("J3").FormulaR1C1 = "الأستاذ / عبد الله باقشير" Range("J4").FormulaR1C1 = "الأستاذ / أحمد فضيلة" Range("J5").FormulaR1C1 = "الأستاذ / رجب جاويش" Range("J6").FormulaR1C1 = "الأستاذ / حماده عمر" Range("J7").FormulaR1C1 = "الأستاذ / هاني عدلي" Range("J8").FormulaR1C1 = "الأستاذ / جمال عبد السميع " Range("J9").FormulaR1C1 = "الأستاذ / احمد عبد الناصر " Range("J10").FormulaR1C1 = "الأستاذ / شوقى ربيع" Range("J11").FormulaR1C1 = "الأستاذ / جمال دغيدي" Range("J12").FormulaR1C1 = "الأستاذ / طارق محمود" Range("J13").FormulaR1C1 = "الأستاذ / ضاحي الغريب" Range("J14").FormulaR1C1 = "الأستاذ / عبد الله المجرب" Range("J15").FormulaR1C1 = "الأستاذ / سعيد بيرم" Range("J16").FormulaR1C1 = "تلميذكم / ياسر خليل" End Sub تقبل تحياتي Officena Staff YasserKhalil.rar

مزرعه ايه بقا يا ابو البراء مانتو هتاكلوها بعد صلاة الجمعه ان شاء الله انت بتحلم بالمزرعه من امبارح هههههههههههههههههههه

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

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

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

الا الا دا في الش اهو في المنتدى وانا مش واخد بالي حبايبي اخي الغالي رجب واحمد وياسر ها هي الروح تظهر وجمالها اركن الجمال ونشوف البط انا دوري بقي ايه في الليله دي بقي وانت يامعلم بالضم والفتح كمان (ياسر) انا سرقت الموبيل بتاع صاحبك عشان تسيبني وتقعد تتكلم معاه وبلغه ان يجي الساعه اتنين الدمرداش اتنين وخمسه همسح الالعاب من ع الموبيل

اهداء لأخوتي في المنتدى فورم ادخال بسيط وتم عمل شاشة دخول للبرنامج بباس ورد ويوزر يمكن تطويعة كيفما تريد عسى ان ينفع به احد الاخوة للدخول للبرنامج User Password Wael Wael@19637 Elhadi 2014 حماية الكود Wael@19637 login.rar

السلام عليكم أخي محمود هذا حل بمعادلات الصفيف تفضل ترحيل المشتريات و المبيعات1.rar

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

السّلام عليكم و رحمة الله و بركاته برنامج رائع .. بارك الله فيك .. جزاك الله خيرًا و زادك من علمه و فضله و ما زاد من روعته هو اللّمسة الجديدة و النظرة الجديدة فائق إحتراماتي

أخى الفاضل / خالد الرشيدى عندك حق يظهر إن الزهايمر اشتغل تانى هذا السطر لم يعد له أهمية فى الكود وفعلا نسيت حذفه بعد الانتهاء من الشكل النهائى للكود ربنا يستر على الذاكره جزاك الله كل خير ودا الشكل النهائى للكود بعد حذف السطر Sub ragab() Dim x As Integer Dim T As Variant Dim S_name As Range '============================================================= For Each T In Array("عام", "خاص", "مغلق", "مفتوح") On Error Resume Next With Sheets(T) Set S_name = .Columns(2).Find(What:=[d5], LookAt:=xlWhole) x = Application.WorksheetFunction.Match(T, [c8:c11], 0) + 7 .Cells(S_name.Row, 3) = Cells(x, 4) End With Next End Sub

السلام عليكم تفضل أخى محمود Sub ragab() Dim x As Integer Dim T As Variant Dim Rng As Range Dim S_name As Range '============================================================= For Each T In Array("عام", "خاص", "مغلق", "مفتوح") On Error Resume Next With Sheets(T) Set Rng = .Range("B6:B" & Cells(Rows.Count, "B").End(xlUp).Row) Set S_name = .Columns(2).Find(What:=[d5], LookAt:=xlWhole) x = Application.WorksheetFunction.Match(T, [c8:c11], 0) + 7 .Cells(S_name.Row, 3) = Cells(x, 4) End With Next End Sub بيانات1.rar

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

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

اللهم ما أصبح بي من نعمة أو بأحد من خلقك فمنك وحدك لا شريك لك فلك الحمد ولك الشكر.

أخي الكريم سامح طاهر هلا غيرت اسم الظهور للغة العربية ليعبر عن شخصكم الكريم جرب الكود التالي عله يفي بالغرض .. سيتم وضع معادلات في الخلية E1 والخلية F1 في الملفات المغلقة كما سيتم إخفاء العمودين C و D .. يمكنك التعديل بما يتناسب مع ملفك (ولا تطلب التعديل طالما أنك لم ترفق ملف من البداية .. طبعاً بهزر معاك .. ) ولكن للأسف الموضوعات التي لا يتم إرفاق ملف فيها غالباً ما يتم فيه تقديم مشاركات كثيرة حتى نصل للمطلوب وستلاحظ ذلك بنفسك ..بخلاف الموضوعات التي يكون فيها ملف مرفق Sub LoopThroughClosedWBs() Dim WBK As Workbook Dim FolderPath As String Dim FileName As String Dim Counter As Double FolderPath = ThisWorkbook.Path & "\" FileName = Dir(FolderPath & "*.xl*") Application.ScreenUpdating = False Application.Calculation = xlManual Do While FileName <> "" If FileName <> ThisWorkbook.Name Then Set WBK = Workbooks.Open(FolderPath & FileName) With WBK.Sheets("Sheet1") .Range("E1").Formula = "=SUM(A1:B1)" .Range("F1").Formula = "=A1*B1" .Columns("C:D").Hidden = True End With WBK.Close SaveChanges:=True End If FileName = Dir() Loop Application.Calculation = xlAutomatic Application.ScreenUpdating = True MsgBox "Finished ...", 64 End Sub وإليك الملف المرفق من عندي تقبل تحياتي Loop Through Closed Workbooks & Type Formulas And Hide Columns YasserKhalil.rar

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

هذا لانك وضعت العلامة العشرية للنص كنقطة و نفس الشيء للارقام ليعمل الكود كما تريد يرجى فصل الاحرف بعلامة غير النقطة و سوف يتم تعديل الكود بعد ذلك يمكتك استبدال لكود ليصبح هكذا Sub extract_numbers() Dim mycol As New Collection Dim mycol1 As New Collection Dim mytext, mytext1 As String lr = Cells(Rows.Count, 1).End(3).Row For i = 2 To lr x = Application.WorksheetFunction.Trim(Range("a" & i).Value) On Error Resume Next For t = 1 To Len(x) y = Mid(x, t, 1) If IsNumeric(y) Or Asc(y) = 46 Then mycol.Add y mytext = mytext & y Else mycol1.Add y mytext1 = mytext1 & y End If Next If Asc(Right((mytext), 1)) = 46 Then Cells(i, 2) = Left(mytext, Len(mytext) - 1) Else Cells(i, 2) = mytext End If Cells(i, 3) = Left(mytext1, Len(mytext1) - 1) & Chr(46) & Right(mytext1, 1) mytext = "" mytext1 = "" Next End Sub

وعليكم السلام ورحمة الله وبركاته مرحبا اخي الكريم لم توضح ما هو اصدار الاوفيس الذي تعمل عليه ولم توضح ايضاً طريقة التحزيم مبدئياً : حمل access runtime الخاص بنفس النسخة التي تعمل عليها ( جميع الاصدارات الخاصة بـ access runtime متاحة مجاناً بمايكروسوفت ) ثم استخدم برنامج Smart Install Maker لتحزيم البرنامج تحياتي

بسم الله الرحمن الرحيم http://up.top4top.net/downloadf-484ol21-rar.html

السلام عليكم أستاذ عبدالعزيز في مثل امريكي يقول: اذا الشئ ما مكسور ، لا تصلحه ليش غيرت اسم الحقل الى esm-altalep ؟ هذه كانت مشكلتك ، فارجعتها الى a3 ، والسلام ، طبعا شكرا انك اعطيتني رابط البرنامج الاصل ، اللي به عملت المقارنة واكتشفت الخطأ . والنتيجة: جعفر 288.المعلم اليمني1.mdb.zip

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

=Sum(Val(Nz([num];0))+Val(Nz([num2];0))+Val(Nz([num3];0))) أخي الكريم: استخدم هذا التعبير

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

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

وعليكم السلام انا غيرت شوي على المثال السابق: . ولكن ، اذا عملت التغيير التالي على التقرير وفي المجموعات والفرز: . فالنتيجة: جعفر 286.برنامج حساب الاجازات 3.accdb.zip

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

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

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

استبدل الكود بهذا Function myfacteur(Myfact As Long, n1 As Integer, n2 As Integer, n3 As Integer, n4 As Integer) As Long '''''''''''''''''''''''''''''''''''''''''' Select Case Myfact Case 0 To 70 How_Many = Myfact * n1 Case 70.00001 To 80 How_Many = (70 * n1) + (Myfact - 70) * n2 Case 80.0001 To 200 How_Many = (70 * n1) + (10 * n2) + (Myfact - 80) * n3 Case Is > 200.001 How_Many = (70 * n1) + (10 * n2) + (120 * n3) + (Myfact - 200) * n4 End Select myfacteur = How_Many '''''''''''''''''''''''''''''''''''''''' End Function و يكون شكل المعادلة الجديدة =myfacteur(f3,5,9,15,17)

انسخ الكود من هذا الملف الى ملفك و جربه (في موديل جديد) و اكتب الدالة التالية في الخلية تحت فيمة الاستهلاك مباشرة واسحب نزولاً =myfacteur(f3,5,9,17) facteur_electrique.zip

تعلم أكسس 2007 | الفصل الثاني: إنشاء الجداول

كود إضافة القائمة المنسدلة إلى خلية في إكسل Sub Add_Drop_Down_Menu_Cell() With Range("C1").Validation .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, _ Formula1:="=$B$1:$B$9" .IgnoreBlank = True .InCellDropdown = True End With End Sub مرفق ملف به التطبيق

كود لعرض معلومات عن الملف الذى تعمل عليه Sub ShowFolderSize(filespec) Dim fs, F, S Set fs = CreateObject("Scripting.FileSystemObject") Set F = fs.GetFile("E:\Bids.xls") S = "File Name :" & UCase(F.Name) & vbLf & _ "Total Size: " & FormatNumber(F.Size) & " Kbytes" & vbLf & _ "Created :" & F.DateCreated & vbLf & _ "Modifide :" & F.DateLastModified & vbLf & _ "Last Accessed: " & F.DateLastAccessed MsgBox S, 0, "File Size Info" Open "Log.log" For Append As #2 'Open file Print #2, S Close #2 'Close Exit Sub 'Exit End Sub ' Sub GetII() ' ShowFolderSize (filespec) ' End Sub

السلام عليكم ورحمة الله وبركاته ارفق لكم برنامج ذمم ينقسم الى 48 صفحة رئيسيه للذمم الرئيسي وصفحة خاصة بذمم المتفرقات وقد استخدمت بالصفحات مبدأ الداتا لست بالاضافة الى بعض الاكواد البسيطه جدا اتمنى ان يعجبكم وادعوا لي ان يتقبل الله عمرتي في 11_4_2010 واسلام عليكم ورحمة الله وبركاته ذمم المحل.rar