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

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

السلام عليكم ورحمة اله تعالى وبركاته أما بعد .. استكمالاً لمشاركتي في الموضوع السابق اضع بين ايديكم البرنامج + ملف توليد السيريال .. واعتذر على التأخير ملاحظة : جميع البيانات في الجدول يمكن تشفيرها كلاً حسب طريقته لذلك تركتها بدون تشفير لكي تتضح طريقة عمل البرنامج اتمنى ان ينال اعجابكم تحياتي count-sec.mdb registration_key.mdb

من المعروف ان الدالة Match تعطينا أول صف تراه في الجدول لكن بحيلة بسيطة يمكننا التغلب على هذه الدالة لتعطينا كل الصفوف (كل ذلك دون أخطاء N/A#) شاهد هذا الملف Multi_Match.xlsx

هذه تجاربي . و . جعفر

وعليكم السلام اخي صالح 🙂 مسقط التصفح يعمل ملف اكسس جديد ، ويعمل جدول بحقوله ، ونموذج بكائناته وكود لها : . جعفر

رجاء تجربة الملف المرفق الآن 1003.zip

لك ما تريد _(تم تبديل الملف لان جحمه كبير جداً مما يعيق تنفيذ الماكرو) الكودين Option Explicit Sub FiND_DATA() Dim i%: i = 2 Dim arr, k%: k = 1 Dim H% Dim rg As Object Dim My_Table As Range: Set My_Table = Sijjel.Range("a1:L100") Salim.Cells.Clear Set rg = CreateObject("system.collections.arraylist") With rg Do Until Sijjel.Range("E" & i) = vbNullString If Not .contains(Sijjel.Range("E" & i).Value) And _ Application.CountIf(Sijjel.Range("E2:E" & i), Sijjel.Range("E" & i)) = 1 Then .Add Sijjel.Range("E" & i).Value End If i = i + 1 Loop Salim.Range("q1").Formula = "اسم المنتسب" '==================== For i = 0 To rg.Count - 1 Salim.Range("q2") = rg.Item(i) My_Table.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Salim.Range("Q1:q2"), _ CopyToRange:=Salim.Range("A" & k) H = Salim.Cells(Rows.Count, 5).End(3).Row k = H + 3 Next End With Salim.Range("q1:q2") = vbNullString Find_emPty End Sub '''''''''''''''''''''''''''''''''''''''' Sub Find_emPty() Dim lre%: lre = Salim.Cells(Rows.Count, "E").End(3).Row Dim arr1(), arr2() Dim i%, k%: k = 1 'Dim m%: m = 2 For i = 2 To lre If Salim.Cells(i, "e") = vbNullString Then ReDim Preserve arr1(1 To k): arr1(k) = Salim.Cells(i, "e").Row k = k + 1 i = i + 1 End If Next '====================================== Dim rg As Range Dim txt$ Dim f_addres$ txt = "اسم المنتسب" Dim m%: m = 1 Dim x x = Salim.Cells(Rows.Count, "E").End(3).Row Set rg = Range("E1:e" & x).Find(txt, after:=Cells(x, 5), LookIn:=xlValues, lookat:=xlPart) If Not rg Is Nothing Then f_addres = rg.Row + 1 Do ReDim Preserve arr2(1 To m): arr2(m) = rg.Row + 1 m = m + 1 If m > x - 1 Then Exit Do Set rg = Range("E1:e" & x).FindNext(rg) Loop While rg.Row + 1 > f_addres Else End If ReDim Preserve arr1(1 To UBound(arr1) + 1) arr1(UBound(arr1)) = x + 1 For i = 1 To UBound(arr2) Cells(arr1(i), 1).Resize(, 12).Interior.ColorIndex = 6 Cells(arr1(i), 6) = Application.Sum(Range(Cells(arr2(i), 6), Cells(arr1(i) - 1, 6))) Cells(arr1(i), 7) = Application.Sum(Range(Cells(arr2(i), 7), Cells(arr1(i) - 1, 7))) Cells(arr1(i), 8) = Application.Sum(Range(Cells(arr2(i), 8), Cells(arr1(i) - 1, 8))) Cells(arr1(i), 9) = Application.Sum(Range(Cells(arr2(i), 9), Cells(arr1(i) - 1, 9))) Cells(arr1(i), 10) = Application.Sum(Range(Cells(arr2(i), 10), Cells(arr1(i) - 1, 10))) Cells(arr1(i), 11) = Application.Sum(Range(Cells(arr2(i), 11), Cells(arr1(i) - 1, 11))) Cells(arr1(i), 12) = Application.Sum(Range(Cells(arr1(i), 6), Cells(arr1(i), 11))) Next '================================== End Sub '============================= الملف مرفق Badil.xlsm

شو قصدك لا تعمل ، واي خطأ بها؟

وتعلمت اليوم شيء جديد ، شكرا لك اخي محمد 🙂 لم انتبه ان هناك حقل نص وحقل تاريخ في الكود ، لذلك حصلت على هذه الرسالة والرسالة التي تليها 😞 تفضل التعديل المبيعات Dim mySQL As String mySQL = "INSERT INTO invoice ( sit_ID, catcod, fatora_no, mvdate, Qtyout, price, Total, storid, mvTyp, mosadd, baqy) " mySQL = mySQL & Chr(32) & "SELECT " & Forms!invoicesale!sit_ID & ", " & Forms!invoicesale!catcod & ", '" & Forms!invoicesale!f_no & "', " mySQL = mySQL & Chr(32) & "#" & Forms!invoicesale!movedate & "#, " & Forms!invoicesale!Qtyout & ", " & Forms!invoicesale!PRICESALE & ", " mySQL = mySQL & Chr(32) & Forms!invoicesale!Total & ", " & Forms!invoicesale!storid & ", " & Forms!invoicesale!mvTyp & ", " mySQL = mySQL & Chr(32) & Forms!invoicesale!mosadd & ", " & Forms!invoicesale!baqy 'او ' mySQL = "INSERT INTO invoice ( sit_ID, catcod, fatora_no, mvdate, Qtyout, price, Total, storid, mvTyp, mosadd, baqy) " ' mySQL = mySQL & Chr(32) & "SELECT Forms!invoicesale!sit_ID , Forms!invoicesale!catcod , Forms!invoicesale!f_no , " ' mySQL = mySQL & Chr(32) & "Forms!invoicesale!movedate , Forms!invoicesale!Qtyout , Forms!invoicesale!PRICESALE , " ' mySQL = mySQL & Chr(32) & "Forms!invoicesale!Total , Forms!invoicesale!storid , Forms!invoicesale!mvTyp , " ' mySQL = mySQL & Chr(32) & "Forms!invoicesale!mosadd , Forms!invoicesale!baqy" DoCmd.RunSQL mySQL . الشراء Dim mySQL As String mySQL = "INSERT INTO invoice ( sp_ID, catcod, fatora_no, mvdate, Qtyin, price, Total, storid, mvTyp, mosadd, baqy) " mySQL = mySQL & Chr(32) & "SELECT " & Forms!invoicebuy!supp_ID & ", " & Forms!invoicebuy!catcod & ", '" & Forms!invoicebuy!f_no & "', " mySQL = mySQL & Chr(32) & "#" & Forms!invoicebuy!movedate & "#, " & Forms!invoicebuy!Qtyin & ", " & Forms!invoicebuy!pricebuy & ", " mySQL = mySQL & Chr(32) & Forms!invoicebuy!Total & ", " & Forms!invoicebuy!storid & ", " & Forms!invoicebuy!mvTyp & ", " mySQL = mySQL & Chr(32) & Forms!invoicebuy!mosadd & ", " & Forms!invoicebuy!baqy 'او ' mySQL = "INSERT INTO invoice ( sp_ID, catcod, fatora_no, mvdate, Qtyin, price, Total, storid, mvTyp, mosadd, baqy) " ' mySQL = mySQL & Chr(32) & "SELECT Forms!invoicebuy!supp_ID , Forms!invoicebuy!catcod , Forms!invoicebuy!f_no , " ' mySQL = mySQL & Chr(32) & "Forms!invoicebuy!movedate , Forms!invoicebuy!Qtyin , Forms!invoicebuy!pricebuy , " ' mySQL = mySQL & Chr(32) & "Forms!invoicebuy!Total , Forms!invoicebuy!storid , Forms!invoicebuy!mvTyp , " ' mySQL = mySQL & Chr(32) & "Forms!invoicebuy!mosadd , Forms!invoicebuy!baqy" DoCmd.RunSQL mySQL . جعفر 1003.zip

جرب هذا الماكرو (لا أعلم لماذا هذا الحجم اكثر للملف اكثر من 4 ميفا) Option Explicit Sub FiND_DATA() Dim i%: i = 2 Dim arr, k%: k = 1 Dim H% Dim rg As Object Dim My_Table As Range: Set My_Table = Sijjel.Range("d1:m100") Salim.Cells.Clear Set rg = CreateObject("system.collections.arraylist") With rg Do Until Sijjel.Range("F" & i) = vbNullString If Not .contains(Sijjel.Range("f" & i).Value) And _ Application.CountIf(Sijjel.Range("F2:f" & i), Sijjel.Range("F" & i)) = 1 Then .Add Sijjel.Range("F" & i).Value End If i = i + 1 Loop Salim.Range("q1").Formula = "اسم المنتسب" '==================== For i = 0 To rg.Count - 1 Salim.Range("q2") = rg.Item(i) My_Table.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Salim.Range("Q1:q2"), _ CopyToRange:=Salim.Range("A" & k) H = Salim.Cells(Rows.Count, 1).End(3).Row k = H + 3 Next End With Salim.Range("q1:q2") = vbNullString End Sub الملف مرفق صفحة Salim عملSALIM.xlsm

وعليكم السلام 🙂 الافضل تقسيم جملة SQL الى اكثر من سطر: هكذا : بدل هذين السطرين DoCmd.RunSQL "INSERT INTO invoice ( sp_ID, catcod, fatora_no, mvdate, Qtyin, price, Total, storid, mvTyp, mosadd, baqy) " & vbCrLf & _ "SELECT forms!invoicebuy!supp_ID AS Expr1, forms!invoicebuy!catcod AS Expr2, forms!invoicebuy!f_no AS Expr3, forms!invoicebuy!movedate AS Expr4, forms!invoicebuy!Qtyin AS Expr5, forms!invoicebuy!pricebuy AS Expr6, forms!invoicebuy!Total AS Expr7, forms!invoicebuy!storid AS Expr8, forms!invoicebuy!mvTyp AS Expr9, forms!invoicebuy!mosadd AS Expr10, forms!invoicebuy!baqy AS Expr11" استعمل Dim mySQL As String mySQL = "INSERT INTO invoice ( sp_ID, catcod, fatora_no, mvdate, Qtyin, price, Total, storid, mvTyp, mosadd, baqy) " mySQL = mySQL & Chr(32) & "SELECT " & Forms!invoicebuy!supp_ID & ", " & Forms!invoicebuy!catcod & ", " & Forms!invoicebuy!f_no & ", " mySQL = mySQL & Chr(32) & Forms!invoicebuy!movedate & ", " & Forms!invoicebuy!Qtyin & ", " & Forms!invoicebuy!pricebuy & ", " mySQL = mySQL & Chr(32) & Forms!invoicebuy!Total & ", " & Forms!invoicebuy!storid & ", " & Forms!invoicebuy!mvTyp & ", " mySQL = mySQL & Chr(32) & Forms!invoicebuy!mosadd & ", " & Forms!invoicebuy!baqy DoCmd.RunSQL mySQL جعفر

السلام عليكم راجع الملف المرفق وفيه ما تريد (طباعة قسم واحد - طباعة بخاصية من... إلى... - طباعة الكل). الخلية A1 لم تعد فيها قائمة منسدلة واستُبدلت بمعادلة متعلقة بقيمة الخلية O1 (قيمة مخفية باللون) والتي (الخلية O1) يتحكم في قيمتها الكائن الموجود في هذه الخلية. لأي استفسار آخر أو إضافات أخرى تجدني إن شاء الله في الخدمة... بن علية حاجي 1علوم.xlsm

السلام عليكم بعض التعديلات تمت على الملف... راجع الملف المرفق. القوائم جعلتها تتغير حسب القائمة المنسدلة للأقسام (الخلية A1). لأي استفسار أو إضافات تجدني إن شاء الله في الخدمة... بن علية حاجي 1علوم.xlsx

السادة الزملاء تم تخديث الفيديوهات على اليوتيوب ورفعها على المنتدى كل فيديو فى مكانه أسئلة كثيرة تتردد على مسامعي منها على سبيل المثال : http://magdiyonis54.blogspot.com.eg/ كيفية تصميم شيت اكسل كيفية عمل جدول تنسيق الجدول كيفية إدخال البيانات إضافة الألوان وضبط النصوص دمج الخلايا أبجدة الأسماء التنسيق الشرطي الجمع ومستوى الطالب ( ممتاز جيد ......) وضع السري عمل التسلسل إظهار الصفوف وإخفائها هذه الأسئلة سأجيب عنها وبطريقة بسيطة وبعيد عن المعادلات للهواة أو لطالبى كيفية عمل شيت للامتحانات عنوان المنتدى http://magdiyonis1.forumegypt.net عنوان المدونة الخطوة الاولى.rar

تفضل index2.xlsm

اهلا بك اخ كريم فى المنتدى تفضل حضور وانصرف المواظفين يناير 2019.xlsx

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

بارك الله فيك استاذ عبداللطيف

في الإكسيل هذا غير ممكن البتة... الخلية الواحدة في الإكسيل لا يمكن تقسيمها إلى جدول (إلا إذا كانت في الأصل مدمجة)....

بارك الله فيكم جميعا وجزاكم الله كل خير مجهودات ممتازة وعمل رائع

السلام عليكم ورحمة الله أخي سليم، الكود الذي أنجزته رائع جدا والكود الثاني أروع، ولم أكن أعلم أن صاحب الموضوع طلب عناوين الخلايا (الحقول) الفارغة... وقد قمت بالتعديل على الكود السابق بما يلي: Private Sub Worksheet_Deactivate() For I = 1 To 7 If Cells(I + 4, 4) = "" Then S = S & "$D$" & I + 4 & ", " Next If Application.CountA(Range("D5:D11")) < 7 Then Feuil1.Activate: _ MsgBox " : لا يمكنك الخروج من الشيت. هناك حقول فارغة في الخلايا التالية" & Chr(10) & Mid(S, 1, Len(S) - 2) End Sub بن علية حاجي Book1.xlsm

كود اخر و اقصر (مع عدم السماح بكتابة أكثر او اقل من 11 رقماً في الخلية D8) Option Explicit Private Sub Worksheet_Deactivate() Dim my_rg As Range On Error Resume Next Set my_rg = Sheets("Sheet1") _ .Range("d5:d11").SpecialCells(4) On Error GoTo 0 If Not my_rg Is Nothing Then Sheets("Sheet1").Select MsgBox "There Are Empty Cells:" & my_rg.Address End If End Sub الملف مرفق No_Out_New.xlsm

السلام عليكم ورحمة الله بارك الله فيك أخي سليم، إبداع ما فوقه إبداع... وأقترح تبسيطا (اختصارا) للمعادلة في الخلية E2 (ثم سحبها نزولا): =IF(ROWS($A$1:A1)>COUNTIF($B$2:$B$100;$E$1);"";MATCH(E$1;OFFSET($B$2;SUM(E1);0;ROWS($B1:$B$100)-SUM(E1));0)+SUM(E1)) أو =IF(ROWS($A$1:A1)>COUNTIF($B$2:$B$100,$E$1),"",MATCH(E$1,OFFSET($B$2;SUM(E1),0,ROWS($B1:$B$100)-SUM(E1)),0)+SUM(E1)) بن علية حاجي

السلام عليكم

السلام عليكم أعتذر أخي على التأخر بالرد و لكن حتى تمكنت من استخدام الحاسب استعلام جدولي-الاعمدة صفوف.accdb

جرب هذا الماكرو Sub Extract_uniques() Dim i% Dim My_rg As Range: Set My_rg = Range("a3:b21") Range("c3").Resize(My_rg.Rows.Count, 1).ClearContents With CreateObject("System.Collections.ArrayList") For i = 1 To My_rg.Cells.Count If Application.CountIf(My_rg, My_rg.Cells(i)) = 1 Then .Add (My_rg.Cells(i).Value) End If Next .Sort Range("c3").Resize(.Count) = Application.Transpose(.ToArray) End With End Sub الملف مرفق Aziz.xlsm

السلام عليكم منذ تعرفي على vba excel احببت التعامل مع اليوزر فورم والأكواد وكل ما يتعلق بهم بعد طرحي لموضوع برنامج تتبع وتسيير شؤن اللأليات والموضفين المصمم على الإكسل احببت ان اقدم لكم اليوم جزأ من برنامج صممته على يوزر فورم بعدما ترجمته الى اللغة العربية لأن النسخة الاصلية صممتها باللغة الفرنسية أروج أن تستفيدو منه الباسورد للبرنامج ولمحرر الأكواد هو 123 برنامج تسيير شؤن الموضفين.rar

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

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

اخى ابو الياس انا مازلت ارى ان المشكله فى الاعدادات حيث يوجد خيارForm Image قم بتحديده بالصورة الاولى الموضحه بالملف الخاص بك فى نافذة Print VBA Project ثم اختر SETUP ثم Landscape وسيكون ذلك هو الحل بإذن الله

اخي ابو نصار كود جميل جدا و الشكر موصول لصاحب الفضل دائما استاذنا الفاضل عبد الله عندما قرات الموضوع للتو تذكرت كودا عندي بنفس الفكرة ادراج معادلة في نهاية فواصل الصفحات فاحببت ان اثري الموضوع لزيادة الفائدة ... شكري و احترامي... formula in the end of the page.rar

الاخ الاستاذ الحبيب أبو حنين اشكرك على التشجيع والمرور الكريم جزاك الله كل خير الاخ الفاضل ايهاب سعيد ماذ تقصد بعنواين الصفوف حسب مافهمت جرب التعديل التالي مجاميع الصفحات حسب عناوين الصفوف في العمود A التي باللون الاحمر في معاينة الطباعه '**************************************** ' بداية البيانات بدون رؤس الأعمدة Private Const Row_Star As Integer = 2 '**************************************** 'الاعمدة المراد جمع قيمها في نهاية فواصل الصفحات Private Const C_N As String = "$B$1,$C$1,$D$1:$F$1" Sub Ali_Sum_Page() Dim Ar() As Integer Dim Rng As Range, Cc As Range Dim C As Range, Cr As Range Dim iCont As Integer Dim Arc As Variant Dim P_c Dim i As Integer, ii As Integer Dim r1 As Integer, r2 As Integer Dim Cv As Integer, L_C As Integer ''''''''''''''''''' On Error Resume Next Arc = Range(C_N).Address(0, 0) P_c = Range(Mid(Arc, 1, 2)).Column For Each Cc In Range(C_N) L_C = Cc.Column Next With Cells.Worksheet With .PageSetup .PrintTitleRows = "$1:$1" .PrintTitleColumns = "" End With .ResetAllPageBreaks .Range("A65536").Select .Cells(Row_Star, "A").Select iCont = .HPageBreaks.Count If iCont = 0 Then Exit Sub ''''''''''''''''''''''' ReDim Ar(1 To iCont) For i = 1 To .HPageBreaks.Count ii = .HPageBreaks(i).Location.row Ar(i) = ii Next ''''''''''''''''''''''' r1 = Row_Star For i = 1 To iCont ii = Ar(i) - 1 With .Cells(ii, P_c).Resize(1, L_C) .EntireRow.Insert With .Offset(-1, 0) L_r = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row If Rng Is Nothing Then Set Rng = .Cells Else Set Rng = Union(Rng, .Cells) r2 = ii - 1 For Each C In Range(C_N) Cv = C.Column .Cells(1, Cv) = WorksheetFunction.Sum(Range(Cells(r1, Cv), Cells(r2, Cv))) With Cells(.row, 1) .Value = WorksheetFunction.CountA(Range(Cells(r1, Cv), Cells(r2, Cv))) .Interior.Color = RGB(255, 0, 0) End With Next r1 = r2 + 2 End With End With Next For Each Cr In Range(C_N) Cv = Cr.Column With .Cells(L_r, Cv) .Value = WorksheetFunction.Sum(Range(Cells(r1, Cv), Cells(L_r - 1, Cv))) With Cells(L_r, 1) .Value = WorksheetFunction.CountA(Range(Cells(r1, Cv), Cells(L_r - 1, Cv))) .Interior.Color = RGB(255, 0, 0) End With .Interior.ColorIndex = 6 End With Next End With '''''''''''''''''''''' If Not Rng Is Nothing Then With Rng .Interior.ColorIndex = 6 .Worksheet.PrintPreview Range("A" & L_r).EntireRow.Delete .EntireRow.Delete End With End If ''''''''''''''''''''''' Erase Ar Set Rng = Nothing: Set Cc = Nothing Set Cr = Nothing: Set C = Nothing End Sub Kh_Sum_Pages_A.rar

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

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

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

الاخ عباس والاخ عبد الله والاخ ابو ردينه شكرا لكم وكل عام وانتم بخير الان كيفية تساوى ارتفاع الصفوف وادراج عواميد ارتفاع الصفوف.rar

الاخ/ mahmoud شكرا للتهنئة بالعيد الان كيفية تحويل الارقام من الانجليزية للعربية بالاكسل اكسل 2003 و 2010 تحويل الارقام للعربية.rar

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

السلام عليكم استاذنا الحبيب يحياوي اسعد الله مساك الاخوة الاحبه مسائكم فل وياسمين نأتيكم مابجعبتنا كود لإخفاء القوائم تماماً هذا الكود للإخفاء ندرج قيمة FALSE Sub hid_koaeem() Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",false)" End Sub وفي حالة الإظهار ندرج قيمة true هكذا Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",true)" والسلام عليكم

العزيز يحيـــــــــــــــــــــــاوي : هذا الكود - الدخول الى ملف الاكسل عن طريق الفورم مباشرة دون فتح صفحة الاكسل - من اعمال اخونا الاستاذ " احمد حمور " بتصرف ياسر ملاحظة : ( كود فتح اكسل على الفورم فقط ) اما اكواد الفورمز في الملف فهي من اعمال اعضاء واساتذة اخرين في هذا المنتدى وفقك الله ياسر الحافظ " ابو الحارث " دخول الى الفورم مباشرة.rar

الاستاذ يحياوي : تحية طيبة مرفق اكواد رياضية رائعة - 2 ملف - مع شرح بسيط لتطبيقات vba مع الاكسل لاستاذنا الكبير محمد طاهر وفقك الله ياسر الحافظ شرح برنامج اكسل و تطبيقات الفيجوال مع اكواد رياضية رائعة.rar

بسم الله الرحمن الرحيم الاخوة الاعزاء بعد التحية كثرت التسائلات مؤخرا عندما يقوم احد الاعضاء بتحميل ملف من المنتدى وبة بعض الاكواد او الدوال . ويجد به دالة تعمل بصوره جيدة وعندما يريد استخدامها فى ملف اخر لايجدها او لاتعمل معه وهذا حقيقى . احبائى الاكسل علم من اعلام البرامج الجيدة وشامل شمول لايمكن وصفة ولا يجوز القفز داخل الاكسل وبصفة عامة فى مجال الكمبيوتر لايجوز القفز بتاتا . للتعامل مع مستوى معين من الاكسل يلزمك لكل مستوى حد ادنى من المعرفة . فلا يمكن التعامل مع الاكواد الا بحد ادنى من الالمام بالجزء العام من التعامل مع الاكواد سوء استيرادها او تصديرها او اضافتها الى الاكسل كادالة معرفة . هذة امور عامة يجب الالمام بها . وقد كتبت هذا الموضوع بخصوص النقاش الجارى فى مشكلة دالة التفقيط فأردت انتهاز الفرصة لحل مشكلة التفقيط عندما وجدت فى خزانتى دالة للتفقيط من تصميم العلامة ابو هانى . وفى نفس الوقت اقوم بشرح كيفية ادراج دالة التفقيط او اى دالة اخرى لتكون متاحه لك فى اى وقت ولا تحتاج الى نسخ الاكواد الى الملف كلما اردت استعملها . ارفق لكم ملفين عبارة عن : 1 - الملف الاول مثال به دالة التفقيط من تصميم ابو هانى وقد اعجبتنى دون جميع دوال التفقيط فهى مميزة عن باقى الدوال لانها تتعامل مع جميع انواع العملات . 2 - الملف الثانى عبارة عن عرض فيديو لكيفية ادراج اى دالة لتكون متاحة لك للاستخدام العام وهو نموذج عام لذلك . المرفق الاول دالة التفقيط وهى من تصميم ابو هانى : t.rar المفرفق الثانى : عرض فيديو لكيفية ادراج اى دالة لتكون متاحة لك للاستخدام العام فيديو ادراج دالة