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

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

الحمد لله انه تم المطلوب والشكر دوما للمبدع المهندس والعبقري والمتعاون والمبتر للاكواد ياسر الاكسلاني باركه الله وزاده من واسع فضله والأستاذ سليم سلمك الله من كل شر

يرجى توضيح الغرض من الادخال الصوتي وتفضل طريقة التسجيل الصوتي عن طريق الاكسل يتم حفظ المقطع الصوتي المسجل داخل الدريف d:\ باسم Yasser yasser elaraby.rar

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

السلام عليكم ورحمة الله وبركاته يمكنك تحويل التقرير إلى pdf ومن ثم عند الطباعة تحدد الطابعة وتحدد حجم الورقة كود التحويل إلى pdf DoCmd.OutputTo acOutputReport, ReportName, acFormatPDF, , True حيث ReportName هو اسم التقرير

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

السلام عليكم Option Explicit ' بسم الله الرحمن الرحيم " ' ******************** " ' دالة استخراج اسم ولي الأمر " '========================================" ' يامكانية معالجة الاسم المركب الاول " ' تلقائياً حسب معايير معرفة لديها " ' Kh_Father_Replace في الدالة " ' ويمكنك اضافة اي معيار آخر " ' بجانب المعايير الموجودة " ' MyArray في المتغير " ' مع مراعاة وجود فراغ بداية ' او نهاية المعيار '========================================" '----------------------------------------------------------------- Function Kh_Father_Name(ByVal Name As String) As String Dim KhString As String, SearchChar As String, Kh_Mid As String, Kh_Rep As String Dim KhMyNo As Integer On Error GoTo Err_Kh_Father_Name If IsEmpty(Name) Then GoTo Err_Kh_Father_Name KhString = Kh_Father_Replace(Trim(Name)) & " " SearchChar = " " KhMyNo = InStr(1, KhString, SearchChar, 1) Kh_Mid = Trim(Mid(KhString, KhMyNo, Len(KhString))) Kh_Rep = Replace(Kh_Mid, "_", " ") Kh_Father_Name = Kh_Rep Exit Function Err_Kh_Father_Name: Kh_Father_Name = "" End Function Private Function Kh_Father_Replace(ByVal Kh_Sub As String) As String Dim MyArray, Ar Dim Sn As String, Re As String '==================================================== ' يمكنك اضافة اي معيار آخر هنا بجانب المعايير الموجودة MyArray = Array("عبد ", "أبو ", "ابو ", "آل ", " الله" _ , " الدين", " الإسلام", " الاسلام", " الحق") '==================================================== Sn = Kh_Sub For Each Ar In MyArray Re = Replace(Ar, " ", "_") Sn = Replace(Sn, Ar, Re) Next Kh_Father_Replace = Sn End Function استخراج اسم ولي الامر.rar

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

اتفضل اخى ان شاء الله يكون ما تريد بالتوفيق مرتب.rar

جزاك الله كل خير وعافية وشكرا

أخي الكريم جرب التعديل التالي Sub CreateNewSheet() Dim Ws As Worksheet, Sh As Worksheet, Str As String, Y As Integer, X Set Sh = Sheet1 For Each Ws In ThisWorkbook.Worksheets Str = Ws.Range("D3").Formula X = Val(Mid(Str, 2, InStr(Str, "&") - 1)) If Y > X Then Y = Y Else Y = X Next Ws Sh.Copy After:=Sheets(Sheets.Count) With ActiveSheet .Name = "نقد " & Y + 1 .Range("D3").Formula = Replace(.Range("D3").Formula, Val(Mid(.Range("D3").Formula, 2, InStr(.Range("D3").Formula, "&") - 1)), Y + 1) End With Sh.Activate: Sh.Range("A1").Select End Sub فاتورة 2016.rar

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

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

Sub salim() Dim My_date As Date Sheet1.Copy After:=Sheets(Sheets.Count) t = Sheets.Count ActiveSheet.Name = Sheet1.Name & "" & t ActiveSheet.Range("D2").Formula = "=today()" My_date = ActiveSheet.Range("d2").Value My_year = Year(My_date) ActiveSheet.Range("D3").Formula = "'" & t & "/" & My_year End Sub بعد إذن اخي وصديقي ياسر هذا الكود دون ذكر اسماء الصفحات تفادياً لمشاكل اللغة العربية مع تحباتي

جزاك الله خيرا وأحسن الله اليك - ولا برامج تحزيم ولا الغاء شيفت ولا ......... - ما أروعك ولكن السؤال الذى يطرح نفسه الآن كيف نمنع المستخدم من تغير الامتداد بشكل عكسى من accdr الى accdb وجزاكم الله خيرا

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

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

أخي الكريم بو عبد الله جرب الكود التالي عله يفي بالغرض Sub CreateNewSheet() Dim Ws As Worksheet, Y As Integer, X For Each Ws In ThisWorkbook.Worksheets X = Val(Mid(Ws.Range("D3").Formula, 2, 1)) If Y > X Then Y = Y Else Y = X Next Ws Sheets("نقد").Copy After:=Sheets(Sheets.Count) ActiveSheet.Range("D3").Formula = Replace(ActiveSheet.Range("D3").Formula, Val(Mid(ActiveSheet.Range("D3").Formula, 2, 1)), Y + 1) End Sub تقبل تحياتي

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

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

قم باعادة الربط مره اخرى بهذه الطريقة لانه لا يوجد لدي اي امكانيات للوصول لقاعدة اوراكل اكمل انت الباقي yasser.rar

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

أخي الكريم علي المصري إثراءً للموضوع وإضافة للحل الرائع المقدم من أخونا المتميز سليم إليك حل بالأكواد مع الشرح بالتفصيل ..لتستطيع التعديل بما يتناسب مع ملفك الأصلي Sub FilterMarks() 'تعريف المتغيرات Dim Counter As Integer, LR As Integer, I As Integer 'إلغاء تحديث الشاشة لتسريع الكود Application.ScreenUpdating = False 'بدء التعامل مع ورقة العمل النشطة With ActiveSheet 'مسح النطاق الذي ستوضع فيه النتائج .Range("J10:M1000").ClearContents 'حلقة تكرارية من 1 إلى 3 حسب عدد الأعمدة التي سيتم التعامل معها 'فالأعمدة التي سيتم التعامل معها وفلترتها هي العمود ف1 و ف2 و ف3 For Counter = 1 To 3 'إلغاء الفلترة في ورقة العمل قبل البدء في عمليات الفلترة .AutoFilterMode = False 'فلترة النطاق حسب الحقل رقم 2 في الحلقة الأولى ورقم 3 في الحلقة الثانية ورقم 4 في الحلقة الثالثة 'لنستطيع التعامل مع الثلاثة حقول ف1 و ف2 وف3 [Counter] وهنا استخدمنا المتغير المسمى 'وشرط الفلترة أكبر من الدرجة صفر وأقل من أو يساوي الدرجة 50 .Range("B2:E2").AutoFilter Field:=Counter + 1, Criteria1:=">0", Operator:=xlAnd, Criteria2:="<=50" 'نسخ النطاق الذي يحتوي الأسماء ويكون النسخ للخلايا الظاهرة فقط والتي تطابق الشروط .Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy 'لصق الأسماء في العمود المناسب حيث يكون اللصق في أول حلقة في العمود رقم 11 'وفي الحلقة الثانية في العمود رقم 12 وفي الحلقة الثالثة في العمود رقم 13 'اللصق يكون للقيم فقط بحيث نحافظ على التنسيقات الموجودة في نطاق النتائج .Cells(10, Counter + 10).PasteSpecial xlPasteValues 'تحديد أول خلية في ورقة العمل .Range("A1").Select 'الانتقال للحلقة التالية Next Counter 'إلغاء الفلترة في ورقة العمل .AutoFilterMode = False 'تحديد آخر صف في نطاق النتائج من خلال معرفة عدد صفوف النطاق الحالي مضافاً إليها 7 'يمثل الرقم 7 عدد الصفوف السابقة للنطاق الحالي أي نطاق النتائج LR = .Range("K9").CurrentRegion.Rows.Count + 7 'حلقة تكرارية من الصف رقم 10 إلى آخر صف في النطاق الحالي For I = 10 To LR 'الخلية في العمود العاشر تساوي قيمة العداد مطروح منه 9 ليعطي تسلسل للنتائج .Cells(I, "J") = I - 9 'الانتقال للحلقة التالية Next I 'انتهاء التعامل مع ورقة العمل الحالية End With 'إلغاء خاصية القص واللصق بعد عمليات النسخ Application.CutCopyMode = False 'إعادة تفعيل تحديث الشاشة Application.ScreenUpdating = True End Sub تقبل تحياتي Filter & AutoFilter Tutorial YasserKhalil.rar

نفتقدُ أحبَّتنا حينما يغيبون ....لكنَّهم يتذكّرون أننا غبنا عنهم حينما نعودُ إليهم ...سبحان الله

حرب الملف التالي (الورقة الثالثة) بعد عودتي من العمل أقوم بما فمت بطلبه lest 50 salim.rar

بورك في الموهوبة وشكرت الواهب وبلغت رشدها ورزقت برها

القصد انه يمكننا عند فتح البرنامج فك التشفير لتمكين الربط وهذه اكواد لتطبيق فكرة ابو عبدالله من داخل اكسس الحدث الاول للتشفير والآخر لفك التشفير Dim FilePath As String Private Sub Command1_Click() On Error Resume Next FilePath = CurrentProject.path & "\folderName" Name FilePath As FilePath & ".{208D2C60-3AEA-1069-A2D7-08002B30309D}" End Sub Private Sub Command2_Click() On Error Resume Next FilePath = CurrentProject.path & "\folderName" Name FilePath & ".{208D2C60-3AEA-1069-A2D7-08002B30309D}" As FilePath End Sub وهذه زيادة معلومات نسختها من المصدر نفسه بسم الله الرحمن الرحيم هذه طريقة لتشفير الفولدر وإخفاء كل مابداخله من ملفات طبعا الطريقة تعمد على تغيير لاحقة الفولدر برمز من رموز أيقونات الويندوز المتعارف عليها مثل ايقونة الشبكات او جهاز الكمبيوتر أو سلة المهملات وهذه قائمة برموز تلك الايقونات بالإمكان تغييرها في كود البرنامج وسيتم التشفير على ذلك الاساس .. مع قبول تحياتي {0DF44EAA-FF21-4412-828E-260A8728E7F1} Task Bar & Start Menu {1f4de370-d627-11d1-ba4f-00a0c91eedba} Search Folder {208D2C60-3AEA-1069-A2D7-08002B30309D} My Network Places {20D04FE0-3AEA-1069-A2D8-08002B30309D} My Computer {21EC2020-3AEA-1069-A2DD-08002B30309D} Control Panel {2227A280-3AEA-1069-A2DE-08002B30309D} Printers & Faxes {2559a1f4-21d7-11d4-bdaf-00c04f60b9f0} Internet Explorer {2559a1f5-21d7-11d4-bdaf-00c04f60b9f0} Outlook {450D8FBA-AD25-11D0-98A8-0800361B1103} My Documents {645FF040-5081-101B-9F08-00AA002F954E} Recycle Bin {6DFD7C5C-2451-11d3-A299-00C04F8EF6AF} Folder Options {7007ACC7-3202-11D1-AAD2-00805FC1270E} Network Conections {85BBD920-42A0-1069-A2E4-08002B30309D} Briefcase {871C5380-42A0-1069-A2EA-08002B30309D} Internet Explorer {992CFFA0-F557-101A-88EC-00DD010CCC48} Dial-Up Networking {D4480A50-BA28-11d1-8E75-00C04FA31A86} Add Network Place {D6277990-4C6A-11CF-8D87-00AA0060F5BF} Scheduled Tasks {E211B736-43FD-11D1-9EFB-0000F8757FCD} Scanner & Camera أخوكم اكسيرالحياة الاثنين 27 ربيع الاول 1428 الموافق 16 إبريل 2007

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

جرب هذا الملف لتعمل علية المصنف1 salim.rar

تفضل الملف جاهز مع قليل من التنسيق الشرطي للايضاح lest 50 salim.rar

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

تحية طيبة للاستاذ طلعت محمد حسن اسعدني مرورك الكريم شكري وتقديري لك ولهذا المنتدى العملاق عدم ذكر كلمة المرور سهواً لدخول البرنامج:123 محرر الاكواد:251869 الشيت:1

وعليكم السلام تستطيع ان تصغّر الحقول في الجداول ، بالاضافة ، تستطيع ان تجعل بعض الحقول بشكل عمودي بدل الشكل الافقي العادي ، وهذا سيوفر الكثير من المساحة ، واذا فشل كل شئ ، فيمكنك ان تُصدّر البيانات الى اكسل ، وهناك تستطيع ان تُغيّر حجم الصفحة او % (للأسف الاكسس لا يعمل هذا) وتطبعه من الاكسل جعفر

حياك الله اخي الكريم هل من الممكن ارفاق مثال للعتديل وللتجربه ... بالتوفيق

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

أخي الكريم مرسال بالنسبة لطلبك الأول وهو ترحيل الأسماء التي يحتوي الصف الخاص بها على أرقام جرب هذا الكود Sub TransferData() Dim Ws As Worksheet, Sh As Worksheet Dim LR As Long, LastRow As Long, I As Long Set Ws = Sheet1: Set Sh = Sheet2 LR = Ws.Cells(Rows.Count, "D").End(xlUp).Row Application.ScreenUpdating = False For I = 4 To LR If Application.WorksheetFunction.Count(Ws.Range("G" & I & ":AK" & I)) >= 1 Then LastRow = Sh.Cells(Rows.Count, "C").End(xlUp).Row + 1 Sh.Range("B" & LastRow).Resize(1, 37).Value = Ws.Range("B" & I).Resize(1, 37).Value End If Next I Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub أما فيما يخص باقي طلباتك وإن كنت أفضل التعامل مع الطلبات كل طلب بموضوع ، لتجد استجابة أكثر من قبل إخوانك بالمنتدى يرجى توضيح المطلوب بالنسبة للجمع مع ضرب مثال أو مثالين لتتضح الصورة وهل تريد الجمع في ورقة main أم في ورقة اضافي التي سيتم الترحيل إليها ..

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

السلام عليكم ورحمة الله وبركاته أصبحنا على فطرة الإسلام وعلى كلمة الإخلاص وعلى دين نبينامحمّد صلى الله عليه وسلم وعلى ملة أبينا إبراهيم حنيفاً مسلماً وماكان من المشركين

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

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

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

ثانية أدبى كنترول رجب 2013 منازل ثانية ثانوى أدبى.rar

ثانية علمى كنترول رجب 2013 منازل ثانية ثانوى علمى.rar

أخى الفاضل جرب الشيت المرفق كنترول رجب 2013 منازل أولى ثانوى.rar

ثالثا كنترول الصف الثانى الثانوى أدبى كنترول رجب 2014 ثانية ثانوى أدبى.rar

ثانيا كنترول الصف الثانى الثانوى علمى كنترول رجب 2014 ثانية ثانوى علمى.rar

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

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

أرسل لى أخوكم العضو "المجاهد عيسى " هذا الملف لاضافته للمنتدي لمواجهته صعوبات فى الاضافة _________________.zip