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

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

جرب الملف الأن تم التعديل ولا تظهر هذه الرسالة

ليس هناك مشكلة في هذا -أهم حاجة ان الملف يعمل بكل كفاءة

فقط عليك الضغط على Alt +F11 وفتح مديول جديد ووضع هذا الكود به مع تحديد الرينج المطلوب كما بالكود وربطه بالزر Sub Print1() Range("a2:b74").PrintOut End Sub

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

خطرت لي فكرة الأن ولم اجربها وهي النسخ لـ Google Drive أو Dropbox مثلا ........

وعليكم السلام-تفضل الأثاث.xlsm

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

اخى الحبيب انظر لهذا الملف لعله يفى بالغرض نسخة من دمج نتيجة الدورين معا.xlsm

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

أنا لم أفهمك اخى الكريم لأنى قمت بعمل كل اللى انت طلبته ولم يعجبك فماذا أفعل ؟!!!! كما ترى بالصورة واذا كان التفقيط يظهر لك بلغة غريبة عما هو موجود بالصورة فلابد من ضبط اللغة العربية عندك فبها مشكلة ويتم ضبطها من لوحة التحكم (Control Panel)

وعليكم السلام تفضل هذه المعادلة لعدد التمويل الشخصى =SUMPRODUCT(--($A$10:$A$26=$A32),--($C$10:$C$26<>"")) أما معادلة التمويل العقارى فهى : =SUMPRODUCT(--($A$10:$A$26=$A32),--($D$10:$D$26<>"")) 1255555.xlsx

حياك الله

لاحظ الاستعلام الموجود ...... مواد (1).accdb

وعليكم السلام -تفضل 29-7-TOTEXT.xlsm

فضلا منك أدخل بيانات في الجدولين حتى نعرف كيف يتم عمل البرنامج ..... لأنك انت الوحيد الذي تعرف عمل البرنامج .....

حياك الله ... بالتوفيق

قم باختيار الحقلين بالضغط على Shift ثم الضغط على المفتاح .... انظر ....

وعليكم السلام ورحمة الله نعم يمكن ذلك ....... ما شاء الله وصلت لمرحلة تصميم الجداول .... عمل ممتاز ..... واصل .....

وعليكم السلام ... ممكن ارفاق نموذج للجدولين ...

يمكنك متابعة هذه الصور لمعرفة كيف يتم ذلك (بدون اي كود) اذا اردتها بالماكرو الكود Sub hide_tabs() ActiveWindow.DisplayWorkbookTabs = False End Sub لاعادة اظهارها استبدل False بـــ True

تفضل بعد اذن الأستاذ رجب إخفاء الصفحات.xlsm

بسم الله الرحمن الرحيم السلام عليكم احبتي الكرام عندي استعلام اسمه ( طبع ) من خلالة اقوم بطباقة معلومات معلينة // هذا الاستعلام مبني على مجموعة من الجداول // الغريب في الامر عندما اقوم بعمل بطبع يقوم بطباعة مجموعة كبيرة وعندما قمت بفتح الاستعلام تبين فيه تكرار رهيب للمعلومات وكما في الصورة ارجوا من الاخوة الكرام مساعتي في حل هذا الموضوع مثال للجداول مرفق Test.rar

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

السلام عليكم اخي الفاضل كود بدائي ولكنه يقوم بالواجب ان شاء الله. طباعة_الكل.xls

أعتذر لك استاذى الكريم عن المساعدة ,فالملف غامض جدا بالنسبة لى ولم أفهم منه اى شيء فلماذا هناك مثلاً عمودان لأكواد مختلفة لصنف واحد في صفحة المخزن ؟!!!!!! كما انه كيف تريد جمع المبيعات وخصمها من المشتريات على الرغم انك لم تضع في الملف أكواد وأسماء الأصناف للمشتريات ؟!!!!

بارك الله فيك

السلام عليكم حدد جميع الكائنات و أعمل لها ارتساء أفقي -يمين أو يسار- و الإرتساء العمودي - أعلى أو أسفل من الخصائص المهم يكون لها نفس الإرتساء الأفقي و العمودي

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

يا ريت اخي @kanory تجرب وتوافينا بالنتائج

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

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

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

وعليكم السلام-لابد ان يحدث معك هذا الخطأ لأنك تقوم بكتابة المعادلة بطريقة غير صحيحة فلابد ان تكون المعادلة هكذا في كل الصفحات فمثلا اذا كان المبلغ المكتوب بالأرقام الذى تريد تفقيطه في الخلية R2 =kh_TextNum($R2,ورقة1!$E$3,ورقة1!$E$4,ورقة1!$E$5,ورقة1!$E$6,$E$7,$E$8,$E$9) صندوق.xlsm

تفضل يمكنك تفهم هذا من هذه الصورة , ثم بعد خطوات الصورة يمكنك عمل Cut للكود ثم التعديل عليه كما تريد وهذا هو الكود Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Range("A1:h1,H3:H4,E2:G1004,C1000:C1004"), Target) Is Nothing Then Target.Offset(0, 1).Select End If End Sub

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

تفضل أخي محمد بعد تعديل بيانات اضغط على زر "حفظ بيانات" في اسفل النموذج BK .accdb

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

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

رداً على استفسار الاخ ناصر المصري حول اختيار قسمين من الاسم (الاول مع الأخير ) يمكنك استعمال المعادلة التالية مع تحديد الارقام X Y لكنها تعطي في بعض الأحيان خطأ اذا اخترت X Y غير مناسبين مثلا: اذا اردت الاسم الأول والثاني تضع 1 مكان X وتضع 2 مكان Y اذا اردت الاسم الأول فقط تضع 1 مكان X وتضع عددا كبيراً بعض الشيء (20) مكان Y اذا اردت الاسم الثاني فقط تضع 2 مكان X وتضع عددا كبيراً بعض الشيء (20) مكان Y =Salim_Split_Name($A2,X) &" "& Salim_Split_Name($A2,Y) تم وضع UDF جديدة لاختيار اي قسمين من الاسم ( الاول مع الأخير الاول مع الثاني أو الثاني مع الأخير الخ..) الصفحة Salim من هذا الملف الأفضل هو استعمال هذه الدالة Fuction_split_Part_name.xlsm

وعليكم السلام عاشت ايديك استاذ صالح مشكور جزاك الله الخير

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

بارك الله فيك وهديه مقبوله . 🥀

هذا ثوبي نسيته في المطعم

قم بالتعديل على القالب "recap1.dot" واجعل العنوان الذي تريده يتكرر في رأس وتذليل الصفحة كما في الصورة واحفظ ملف الوورد بنفس التسمية "recap1.dot" حفظ كنوع : ‫قالب Microsoft Word 97 - 2003‬ ‎(.dot)‎ بجوار البرنامج وشكراً لك أستاذي صالح للتحرير على رأس وتذليل الصفحة اضغط مرتين على رأس الصفحة

ما شاء الله تبارك الله ..... برنامج جميل ..... تشكر عليه

جرب هذا الملف (لغاية 100 اسم ويمكن الزيادة قدر ما تريد) ولا حاجة للفلتر SORT _WITHOU_VBA.xlsx

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

وعليكم السلام 🙂 اذا كان قصدك ان عندك اكثر من جدول ، وهذه الجداول مرتبطة بعلاقة مع بعض ، وفي الجدول 1 عندك حقل مفهرس وغير قابل للتكرار (مثلا ID) ، وفي الجدول 2 عندك حقل ID ، والجدولين مربوطين بالعلاقة التالية: . فعند حذف اي سجل من الجدول 1 (مثلا ID=5 ) ، فإن جميع سجلات ID=5 في الجدول 2 سوف تحذف تلقائيا (اذا كان المربع الذي عليه السهم ، صح) 🙂 . جعفر

تطوير بسيط على الكود ليكون بشكل أسرع بكثير معتمداً على الفلتر وليس الحلقات التكرارية المملة والمرهقة للبرنامج و اضافة الى ذلك ترقيم تلقائي للطلاب Option Explicit Sub get_Eleves_Names(ByVal my_SHEET As String) Rem ====>>>> Created By Salim Hasbaya On 27/6/2019 Application.ScreenUpdating = False '================================ Dim SH As Worksheet Dim ss% For Each SH In Sheets If SH.Name Like "*#*" Then ss = ss + 1 End If Next Set SH = Nothing '============================ Dim m As Worksheet: Set m = Sheets("Main") Dim But_Sheet As Worksheet: Set But_Sheet = Sheets(my_SHEET) But_Sheet.Range("K1") = ss: ss = 0 Dim Ar(4), Ar_Fasl(1 To 9) Dim t: t = Sheets(my_SHEET).Index Dim Start_row_B%: Dim Start_row_H% Dim mal$: mal = "ذكر" Dim fem$: fem = "انثى" Dim i% But_Sheet.Range("B10").Resize(500, 5).ClearContents But_Sheet.Range("H10").Resize(500, 5).ClearContents '======================================= Dim Filtred_rg As Range: Set Filtred_rg = m.Range("a1").CurrentRegion Dim FinaL_row%: FinaL_row = Filtred_rg.Rows.Count For i = 4 To 12 Ar_Fasl(i - 3) = CStr(But_Sheet.Cells(5, i)) Next With Filtred_rg .AutoFilter 2, mal .Columns(8).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("B10") .Columns(7).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("d10") .Columns(1).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("e10") .Columns(3).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("f10") End With '======================================= With Filtred_rg .AutoFilter 2, fem .Columns(8).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("h10") .Columns(7).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("j10") .Columns(1).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(12).Copy But_Sheet.Range("k10") .Columns(3).Offset(1).Resize(FinaL_row - 1, 1) _ .SpecialCells(xlCellTypeVisible).Copy But_Sheet.Range("L10") End With Start_row_B = But_Sheet.Cells(Rows.Count, "B").End(3).Row Start_row_H = But_Sheet.Cells(Rows.Count, "H").End(3).Row But_Sheet.Range("c10").Resize(Start_row_B - 9) = _ Application.Transpose(Ar_Fasl(t - 1)) But_Sheet.Range("i10").Resize(Start_row_H - 9) = _ Application.Transpose(Ar_Fasl(t - 1)) But_Sheet.Columns("A:L").AutoFit '================================ If Sheets("Main").FilterMode Then _ Sheets("Main").ShowAllData: Filtred_rg.AutoFilter Set m = Nothing: Set But_Sheet = Nothing Erase Ar: Erase Ar_Fasl Application.ScreenUpdating = True End Sub '================================================== Sub EXTACCT_NAME() Dim Impt Dim x% Impt = InputBox("Please Give_me the sheet's name to transfer data" & _ Chr(10) & "Write the sheet's name Without Cotes") If UCase(Impt) = "MAIN" Then MsgBox "I can't Change the values of Principal Sheet" Exit Sub End If On Error Resume Next x = Len(Sheets(Impt).Name) If x = 0 Then On Error GoTo 0 MsgBox "The Sheet: " & Impt & " Not Existes" Exit Sub End If Call get_Eleves_Names(Impt) End Sub الملف من جديد Mes_Eleves_Super.xlsm