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

السلام عليكم اخواني الكرام يسرني ان أقدم لكم هدية متواضعة وهي عبارة عن برنامج صغير لطباعة بطاقات العمل البلاستيكية مفتوح المصدر أقدمت على عمل هذا البرنامج بطلب من أحد الاخوة واهدي منه نسخة الى اخواني في المنتدى البرنامج شغال وقمت بتجربته على طابعة البطاقات يعمل 100% والحمد لله .. انت فقط اضبط اعدادات الطابعة جيداً يمكنك تغيير خلفيات البطاقات على راحتك لان صور خلفيات البطاقات معمولة بالفوتوشوب وجميع المعلومات هي افتراضية وغير حقيقية اسم المستخدم : اوفيسنا رمز المرور : 1234 حمل البرنامج من الرابط المباشر ادناه https://www.mediafire.com/file/yz3abye3mekko8z/234.rar/file الشكر موصول للأستاذ الخبير ابا جودي المحترم لأبداء المساعدة لنا اخواني ذا كانت هناك أخطاء لا تبخلوا علينا بالتنبيه ومنكم نستفيد لا تنسونا بالدعاء ولوالدي بالرحمة والمغفرة -------------------------------------------------------------------------------- 30-11-2020 النسخة المعدلة ، بصيغتي mdb و accdb 🙂 1289.اوفيسنا.zip

وتجميع البيانات بالتاريخ من الى تاريخ كان يجب طلب هذا الشيء من البداية لا أضاعة لمزيد من الوقت Option Explicit Dim i%, Max_ro%, K%, m%, All_rows% Dim J As Worksheet Dim Spes_sh As Worksheet Dim D1 As Date, D2 As Date Dim x As Boolean '+++++++++++++++++++++++++++++++++++ Sub Fil_data() Dim t%, cont%, n% m = 5: t = 5 Set J = Sheets("Justify") All_rows = J.Cells(Rows.Count, 1).End(3).Row If All_rows > 4 Then J.Range("A5:L" & All_rows + 5).Clear End If If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then MsgBox "Type Please a reel date in B2 and C2" Exit Sub End If D1 = Application.Min(J.Range("B2"), J.Range("C2")) D2 = Application.Max(J.Range("B2"), J.Range("C2")) J.Range("B2") = D1: J.Range("C2") = D2 For Each Spes_sh In Sheets If Spes_sh.Name = "Tarhil" Or Spes_sh.Name = "Justify" Then Else Max_ro = Spes_sh.Cells(Rows.Count, 2).End(3).Row If Max_ro = 1 Then GoTo Next_SHeeet For K = 2 To Max_ro If Spes_sh.Cells(K, 1) <= D2 _ And Spes_sh.Cells(K, 1) >= D1 Then J.Cells(m, 2).Resize(, 11).Value = _ Spes_sh.Cells(K, 1).Resize(, 11).Value If Not x Then Else J.Cells(m, 3) = "" End If x = True m = m + 1 End If Next K End If Next_SHeeet: If Spes_sh.Name = "Tarhil" Or _ Spes_sh.Name = "Justify" Then Else J.Cells(m, 2) = "Sum" J.Cells(m, 4).Resize(, 9).Formula = _ "=SUM(D" & t & ":D" & m - 1 & ")" m = m + 1 t = m End If x = False Next Spes_sh If m > 5 Then For cont = 5 To m - 1 If J.Cells(cont, 2) <> "Sum" Then J.Cells(cont, 1) = n + 1 n = n + 1 Else J.Cells(cont, 1).Resize(, 12). _ Interior.ColorIndex = 35 End If Next cont With J.Cells(5, 1).Resize(m - 5, 12) .HorizontalAlignment = xlCenter .Borders.LineStyle = 1: .Font.Size = 14 .Font.Bold = True .Value = .Value .InsertIndent 1 End With For cont = 5 To m - 1 If J.Cells(cont, 2) = "Sum" Then With J.Cells(cont, 2).Resize(, 2) .Merge .HorizontalAlignment = 3 End With End If Next cont End If End Sub الملف لآخر مرّة و سوف أغلق الموضوع بعد الأجابة مباشرة (لا مزيد من الأسئلة) OM_HAMZA_WITH_SUMMATION.xlsm

تم معالجة الأمر البيانات المكررة في اي شيت يقوم الماكرو بادراحها مرة واحدة فقط بمعنى اخر لو تم الضغط على الزر اكثر من مرة (دون التعديل في البيانات Tarhil) لا تتكرر البيانات Option Explicit Dim i%, Max_ro%, K%, m% Dim J As Worksheet Dim Spes_sh As Worksheet Dim D1 As Date, D2 As Date '+++++++++++++++++++++++++++++++++++ Sub Fil_data() Set J = Sheets("Justify") J.Range("A5").CurrentRegion.Clear If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then MsgBox "Type Please a reel date in B2 and C2" Exit Sub End If D1 = Application.Min(J.Range("B2"), J.Range("C2")) D2 = Application.Max(J.Range("B2"), J.Range("C2")) J.Range("B2") = D1: J.Range("C2") = D2 m = 5 For Each Spes_sh In Sheets If Spes_sh.Name = "Tarhil" Or Spes_sh.Name = "Justify" Then Else Max_ro = Spes_sh.Cells(Rows.Count, 2).End(3).Row If Max_ro = 1 Then GoTo Next_SHeeet For K = 2 To Max_ro If Spes_sh.Cells(K, 1) <= D2 _ And Spes_sh.Cells(K, 1) >= D1 Then J.Cells(m, 1) = m - 4 J.Cells(m, 2).Resize(, 11).Value = _ Spes_sh.Cells(K, 1).Resize(, 11).Value m = m + 1 End If Next K End If Next_SHeeet: Next Spes_sh If m > 5 Then With J.Cells(5, 1).Resize(m - 5, 12) .HorizontalAlignment = xlCenter .Borders.LineStyle = 1: .Font.Size = 14 .Font.Bold = True .Value = .Value .InsertIndent 1 End With End If End Sub الملف من جديد OM_HAMZA_SHEETS_NEW.xlsm

تم عمل المطلوب كما تريدين Option Explicit Dim i%, Max_ro%, m% Dim J As Worksheet Dim ro%, col%, my_sum# Dim Spes_sh As Worksheet Dim D1 As Date, D2 As Date '+++++++++++++++++++++++++++++++++++ Sub Fil_data_All() Application.ScreenUpdating = False Set J = Sheets("Justify") J.Range("A5:L5000").Clear If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then MsgBox "Type Please a reel date in B2 and C2" Exit Sub End If D1 = Application.Min(J.Range("B2"), J.Range("C2")) D2 = Application.Max(J.Range("B2"), J.Range("C2")) J.Range("B2") = D1: J.Range("C2") = D2 For Each Spes_sh In Sheets If Spes_sh.Name = "Tarhil" Or Spes_sh.Name = "Justify" Then Else Max_ro = Spes_sh.Cells(Rows.Count, 2).End(3).Row Spes_sh.Range("A2").Resize(Max_ro - 1, 11) _ .Interior.ColorIndex = 35 For col = 3 To 11 my_sum = 0 For ro = 2 To Max_ro If Spes_sh.Cells(ro, 1) <= D2 And _ Spes_sh.Cells(ro, 1) >= D1 Then Spes_sh.Cells(ro, 1).Interior.ColorIndex = 40 Spes_sh.Cells(ro, col).Interior.ColorIndex = 40 my_sum = my_sum + Val(Spes_sh.Cells(ro, col)) End If Next ro ro = J.Cells(Rows.Count, "j").End(3).Row m = IIf(ro = 3, 5, ro + 1) J.Cells(m, col - 1) = my_sum J.Cells(m, 1) = Spes_sh.Name Next col End If Next Spes_sh If m > 5 Then J.Cells(m + 1, 1) = "SUM" J.Cells(m + 1, 2).Resize(, 9).Formula = _ "=SUM(B5:B" & m & ")" J.Cells(5, "J").Resize(m - 4).Formula = _ "=SUM(B5:I5)" With J.Cells(5, 1).Resize(m - 3, 10) .HorizontalAlignment = xlCenter .Borders.LineStyle = 1: .Font.Size = 14 .Font.Bold = True .Value = .Value .InsertIndent 1 End With J.Cells(m + 1, 1).Resize(, 10).Interior.ColorIndex = 40 End If Application.ScreenUpdating = True End Sub الملف مرفق (الكود القديم ما زال يعمل اذا كانت هناك حاجة اليه) Om_Hamz_Matloub.xlsm

السلام عليكم ورحمة الله وبركاته الحمد لله وحده تم حل المشكلة وجدت هذا الكلام 2 Missing primary key or timestamp Make sure the SQL-Server table has a primary key as well as a timestamp column. The timestamp column helps Access to determine if the record has been edited since it was last selected. Access does this by inspecting all fields, if no timestamp is available. Maybe this does not work well with null entries if there is no timestamp column (see 3 Null bits issue). The timestamp actually stores a row version number and not a time. Don't forget to refresh the table link in access after adding a timestamp column, otherwise Access won't see it. (Note: Microsoft's Upsizing Wizard creates timestamp columns when converting Access tables to SQL-Server tables.) في هذا الرابط https://stackoverflow.com/questions/13993301/editing-record-issues-in-access-sql-write-conflict وخلاصة الموضوع أنه كان يجب وضع عمود يسمي الطابع الزمني بالجدول الموجود بالسرفر يبدو أن التحول الي الـ SQL server ليس بالأمر السهل كما كنت أتوقع - ربنا يستر علي اللي جاي 😀 🙃 - وأشكر جميع أساتذتي الأفاضل وجزاكم الله عني خيرا

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

بارك الله فيك استاذي وان شاء الله في ميزان حسناتك

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

الكود بتعامل مع اي عدد من الطلاب يمكنك اضافة ما تريد من اسماء

autoexec basJStreetAccessRelinker m_Arc_Subs فقط 🙂 اما الماكرو ، فقط تغير اسم النموذج (ولا تجعل النموذج منبثق ولا Dialog ، ولا تجعل على فتح النماذج (Maximize) : . وفي برنامجك ، لما تفتح نموذج ، لا تغلق النموذج الذي انت فيه 🙂 جعفر

ما لك علاقة بيهم ، اتركهم كما هم ، ونادهم من الماكرو AutoExec ، كما هو موضح هناك ، و الماكرو AutExec جاهز كما هو ، مجرد غيّر اسم نموذج الافتتاح 🙂 جعفر

1. الحمدلله 🙂 2. تفضل : De_Select : عند اختيار الاسم من النموذج الفرعي للشفت ، وعلشان التقرير الفرعي يعرف اي شفت نتعامل معاه ، Re_query : بعد الاختيارات اعلاه ، نطلب من جميع النماذج/التقرير الفرعي ، اخذ البيانات من الجدول من جديد ، لإظهار القيم الجديده ، Group_Shifts_2 : هذا اللي يجمع الاسماء في التقرير الفرعي ، Where_Am_I : عند النقر في النموذج الفرعي للشفت ، وعلشان التقرير الفرعي يعرف اي شفت نتعامل معاه ، DateFormat : هذا اللي حل مشكلة التاريخ ، Turn_Off : وهذا اللي يغلق جميع الكائنات ، والقائمة العلوية ، autoexec : اول شيء يشتغل في البرنامج ، ويفتح اول نموذج ، ويوسعه ، وينادي دالة اغلاق كل شيء ، وكان (لأني حذفته حسب طلبك، يعيد ربط برنامج الواجهة مع قاعدة بيانات الجداول الخلفية ، لما يكون برنامجك مقسم ، ويطلب منك تختار مكان الجداول الجديدة). 3. حذفتهم ، بس انت الخسران ، لأني ما خليت إلا النوادر وتعب سنين ، ووجودهم ما يؤثر على البرنامج 😁 4. ان شاء الله 🙂 جعفر 1281.8.FRm_Refresh.accdb.zip

رحم الله والديك ، التشخيص الصحيح نصف الحل (اذا ما كان مثل مشهور ، فخذه مني 🙂 ) ، وبه الحمدلله وجدنا الحل (ولأول مرة في حياتي احول تاريخ الكمبيوتر الى الهجري/ام القرى 🙂 ) يا رجال ، مين هذا الاستاذ اللي تتكلم عنه ؟ و ويش دخله في موضوعنا 😁 واذا كنت تتكلم عني انا ، فيا رجال ما عندي ولا حتى الرخصة الدولية في استخدام الكمبيوتر ICDL 😁 انا جعفر والسلام 🙂 جعفر والسلام 1281.7.FRm_Refresh.accdb.zip

وعليكم السلام-تفضل ما تريد بالتنسيقات الشرطية. وتم ايضاً لعمل قائمة منسدلة لإختيار الحروف المطلوبة نظام التقييم للصف االاول بالألوان1.xlsx

وعليكم السلام-تفضل وذلك بإستخدام هذه المعادلة =IF(F3=TODAY()-7,TEXT(F3,"b2dddd")&" , "&"الماضى "&"("&TEXT(F3,"d ")&VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",IF(F3=TODAY()-1,TEXT(F3,"b2dddd")&" , "&"أمس "&"("&TEXT(F3,"d ")&VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",IF(F3=TODAY(),TEXT(F3,"b2dddd")&" , "&"اليوم "&"("&TEXT(F3,"d ")&VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",IF(F3=TODAY()+1,TEXT(F3,"b2dddd")&" , "&"غداً "&"("&TEXT(F3,"d ") & VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",IF(F3=TODAY()+7,TEXT(F3,"b2dddd")&" , "&"القادم "&"("&TEXT(F3,"d ")&VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",""))))) 2.xlsx

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

1-1-2020 الى 31-12-2020 ولوسمحت ارفق لي الملف اللي فيه البيانات اعلاه ، وبروح آخذ غفوة 😁

نعم لاحظت ، والآن اريدك تبحث في النموذج الرئيسي من 1-1-2020 الى 31-12-2020

وافتح الجدول tbl_Shifts

افتح الاستعلام qry_Group_Shifts_by_Dates

وانت في هذا التاريخ ، وبهذه الطريقة في النموذج ، على الكيبورد ، انقر على F11 ، وسترى بقية كائنات البرنامج ، افتح التقرير rpt_Group_Shifts_by_Dates

ممتاز ، اذن "تمكين المحتوى" شغال 🙂 افتح النموذج على اي من التواريخ الموجودة ، وارسل صورة الشاشة

خلينا نمشي خطوة بخطوة : هل يشتغل عندك زر Close Form ، ويغلق النموذج ؟

تفضل أستاذ عمرو ... يمكنك استخدام هذه المعادلة لرقم الصنف =[@[المجموعة الرئيسية ]]&"-"&[@[المجموعة الفرعية]]&"-"&[@[المجموعة تحت الفرعية]] أو هذه المعادلة , فكلاهما يؤدى الغرض المطلوب =CONCATENATE([@[المجموعة الرئيسية ]],"-",[@[المجموعة الفرعية]],"-",[@[المجموعة تحت الفرعية]]) 1بيانات الاصناف.xlsx

وعليكم السلام 🙂 الحمدلله انك حصلت على الجواب الشافي 🙂 هذا اللي دائما اذكره : جعفر

وبرده على اساس اسم الشيت الى هو اسم الحساب هذه لم افهمها

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

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

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

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

تغيير اسماء الصفحات الى الأجنبية لحسن عمل الكود و نسخه Option Explicit Dim i%, Lr% Dim T As Worksheet Dim Spes_sh As Worksheet Dim Flter_rg As Range '+++++++++++++++++++++++++++ Sub ADD_Sheets() Set T = Sheets("Tarhil") Lr = T.Cells(Rows.Count, 2).End(3).Row If Lr < 2 Then Exit Sub With T For i = 2 To Lr If Not Application.Evaluate("ISREF('" & _ .Range("B" & i) & "'!A1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = _ .Range("B" & i) End If Next End With End Sub '+++++++++++++++++++++++++++ Sub transfer_data() Application.ScreenUpdating = False ADD_Sheets If Lr < 2 Then Exit Sub Set Flter_rg = T.Range("A1").CurrentRegion For Each Spes_sh In Sheets If Spes_sh.Name = T.Name Or Spes_sh.Name = "Justify" Then Else Spes_sh.Range("A1").CurrentRegion.ClearContents Flter_rg.AutoFilter 2, Spes_sh.Name Flter_rg.SpecialCells(12).Copy Spes_sh.Range("A1").PasteSpecial (12) End If Next If T.AutoFilterMode Then T.Range("A1").AutoFilter T.Select With Application .ScreenUpdating = True .CutCopyMode = False End With End Sub الملف مرفق OM_HAMZA_SHEETS.xlsm

السلام عليكم ورحمة الله وبركاته اتمنى ان شاء الله أن افيد هذا الصرح المبارك كما افادني كثير ♥ https://youtu.be/5sTIMR0MVc0 ملف العمل.xlsx

للفصل بين الاسطر النصية في كود يجب وضع & + مسافة + (_ الزائدة السفلية). المسافة مهمة للغاية بين الـ ( & ) و ( _ )

جرب هذا ..... DoCmd.RunSQL "INSERT INTO Table_777_MaturityscheduleOte ( Dart,Finncy ,Stop-Salary , CodeStaff,NameStaff , CodeJ,NameJop ,CodeSec,NameSection,CodeAdm,NamAdmin,NamCopmany,DateStarWork,NameAsthkak,SalaryPrimry,BadelMove,BadelTravil,BadelOther,PricDay,NoHourse,NoDayStadar,NoDayAchoal,HorsOverTim,ValueOverTim,HorsBack,ValueHorsBack,StopDay,ValueStopDay,GoAfters,ValueQun,GoAprovit,ValueAprovit,SalaryCut,Akopat,ValueAkopat,Kadwoo,ValueKadwoo,TotalS,TotalCut,TotalFree,Descrption,AccountBank,CodeBancks,NamesBancks,AccountBankCombany,Tawgih,Depet,Elpians,PisceLink ) SELECT tblOrders.&_"" " & _ "FROM Table_776_Maturityschedule.Dart, Finncy, Table_776_Maturityschedule.Stop - salary, Table_776_Maturityschedule.CodeStaff, Table_776_Maturityschedule.NameStaff, Table_776_Maturityschedule.CodeJ, NameJop, Table_776_Maturityschedule.CodeSec, Table_776_Maturityschedule.NameSection, Table_776_Maturityschedule.CodeAdm, Table_776_Maturityschedule.NamAdmin, Table_776_Maturityschedule.NamCopmany, Table_776_Maturityschedule.DateStarWork, Table_776_Maturityschedule.NameAsthkak, Table_776_Maturityschedule.SalaryPrimry, Table_776_Maturityschedule.BadelMove, Table_776_Maturityschedule.BadelTravil, Table_776_Maturityschedule.BadelOther, Table_776_Maturityschedule.PricDay, Table_776_Maturityschedule.NoHourse, Table_776_Maturityschedule.NoDayStadar, """" " & _ "Table_776_Maturityschedule.NoDayAchoal , Table_776_Maturityschedule.HorsOverTim, Table_776_Maturityschedule.ValueOverTim, Table_776_Maturityschedule.HorsBack, Table_776_Maturityschedule.ValueHorsBack, Table_776_Maturityschedule.StopDay, Table_776_Maturityschedule.ValueStopDay, Table_776_Maturityschedule.GoAfters, Table_776_Maturityschedule.ValueQun, Table_776_Maturityschedule.GoAprovit, Table_776_Maturityschedule.ValueAprovit, Table_776_Maturityschedule.SalaryCut, Table_776_Maturityschedule.Akopat, Table_776_Maturityschedule.ValueAkopat, Table_776_Maturityschedule.Kadwoo, Table_776_Maturityschedule.ValueKadwoo, Table_776_Maturityschedule.TotalS, Table_776_Maturityschedule.TotalCut, Table_776_Maturityschedule.TotalFree, Table_776_Maturityschedule.Descrption, Table_776_Maturityschedule.AccountBank, Table_776_Maturityschedule.CodeBancks, Table_776_Maturityschedule.NamesBancks, Table_776_Maturityschedule.AccountBankCombany, " & _ "Table_776_Maturityschedule.Tawgih , Table_776_Maturityschedule.Depet, Table_776_Maturitysc ,PisceLink "" WHERE (((tblOrders.OrderNumber)=[forms]![frmorders]![OrderNumber]));"""

معي هذه الطريقة التي تشترط وجود الجداول في نفس مجلد الواجهات ضع هذه الوظيفة في موديول ثم قم باستدعائها في النموذج الافتتاحي في حدث عند التحميل Public Function connect() Dim dada Dim wrkJet0 As Workspace Dim dbs0 As DAO.Database adad = CurrentProject.Path & "\DATA.accdb" Set wrkJet0 = DBEngine.Workspaces(0) Set dbs0 = wrkJet0.OpenDatabase(adad, False, False, ";PWD=" & "PASSWORD") Dim db As DAO.Database Dim tdf As DAO.TableDef Set db = CurrentDb() For Each tdf In db.TableDefs If (tdf.Attributes And dbAttachedTable) = dbAttachedTable Then On Error Resume Next tdf.Connect = ";DATABASE=" & adad tdf.RefreshLink End If Next End Function عليك تغيير كلمة PASSWORD بكلمة السر الخاصة بقاعدة بيانات الجداول ولاحظ تن قاعدة البيانات عندي اسمها Data.accdb. وعليك كتابة اسم قاعدة البيانات الخاصة بك بدلا منها اتمنى ان تكون الطريقة مفيدة لك اخوك علاء

الكود الصحيح Private Sub Yh_TextFind_Change() Dim MySh As Worksheet Dim LastRow As Integer Dim M As String Dim A As Range, F% Set MySh = Sheets("ورقة1") Yh_ListFind.Clear If Yh_TextFind.Text = "" Then Exit Sub M = Yh_TextFind.Text LastRow = MySh.Cells(Rows.Count, 1).End(3).Row Set A = MySh.Range("F3:F" & LastRow).Find(M, LOOKAT:=1) If A Is Nothing Then Exit Sub F = A.Row Do With Yh_ListFind .AddItem For K = 0 To 9 .List(.ListCount - 1, K) = _ MySh.Cells(A.Row, K + 1) Next K End With Set A = MySh.Range("F3:F" & LastRow).FindNext(A) Loop While A.Row <> F End Sub YESS_w.xlsm

تم اضافة معادلة عن طريق vba =ReverseTxt(B2) استخدم المعادلة في الملف المرفق وبالتوفي ق نص معكوس.xlsm

1-تصغير الملف الى 20 - 40 اسم لا أكثر تختار الأرقام من الخليتين B1 و B2 (في حال الخطأ الماكرو ياخذ الأرقام من 1 الى عدد الطلاب) 2- في حال تريد طالباً واحداَ تكرر رقمه في B1 و B2 مثلاً نريد الطالب رقم 5 نضع 5=B1 و 5=B2 يوجد صفحة مخفية لادراج الجداول (عدم المس بها لحسن سير عمل الماكرو) جرب خذا الملف Dim Mn%, Mx%, LR, k%, t%, i% Dim ValA, ValB Dim xx1%, xx2% '++++++++++++++++++++++++++++++++ Rem Created By Salim Hasbaya On 20/11/2020 Sub CopY_rg(rg As Range, Where%) rg.Copy Saf.Range("A" & Where).PasteSpecial (xlPasteAll) Application.CutCopyMode = False End Sub '++++++++++++++++++++++++++++++++ Sub fil_Rg() Rem Created By Salim Hasbaya On 20/11/2020 LR = Fat.Cells(Rows.Count, 3).End(3).Row If LR < 10 Then Exit Sub xx1 = Val(Fat.Range("B1")) xx2 = Val(Fat.Range("B2")) ValA = IIf(xx1 <= 0, 1, Int(xx1)) ValB = IIf(xx2 <= 0, LR - 9, Int(xx2)) If ValA > LR - 9 Then ValA = 1 If ValB > LR - 9 Then ValB = LR - 9 Mn = Application.Min(ValA, ValB) Mx = Application.Max(ValA, ValB) Fat.Range("B1") = Mn: Fat.Range("B2") = Mx t = Fat.Range("B2") - Fat.Range("B1") + 1 k = 1 Saf.Cells.Clear For i = 1 To t Call CopY_rg(Source.Range("SPES_RG"), k) k = k + 18 Next Saf.Rows.AutoFit End Sub '++++++++++++++++++++++++++++++++++ Sub Get_certificates() Rem Created By Salim Hasbaya On 20/11/2020 fil_Rg Dim Ro1%, Ro2%, Pos% Dim y%, n% Dim A1, A2, A3 A1 = Application.Transpose(Source.Range("Q1:AA1")) A1 = Application.Transpose(A1) A2 = Application.Transpose(Source.Range("Q2:AA2")) A2 = Application.Transpose(A2) A3 = Application.Transpose(Source.Range("Q3:AA3")) A3 = Application.Transpose(A3) Pos = 8 Ro1 = Fat.Range("B1") + 9 Ro2 = Fat.Range("B2") + 9 For y = Ro1 To Ro2 Saf.Cells(Pos - 6, 3) = Fat.Cells(y, 3) For n = LBound(A1) To UBound(A1) If Saf.Cells(Pos, 1) = "" Then Exit For Saf.Cells(Pos, 3).Offset(, n - 1) = _ Fat.Cells(y, A1(n)) Saf.Cells(Pos, 3).Offset(1, n - 1) = _ Fat.Cells(y, A2(n)) Saf.Cells(Pos, 3).Offset(2, n - 1) = _ Fat.Cells(y, A3(n)) Next n Pos = Pos + 18 Next y Saf.PageSetup.PrintArea = Saf.Range("a1") _ .Resize(Pos - 10, 14).Address End Sub Khiri.xlsm

تفضل يا صديقي مجرد ان تدخل كود موجود مسبقاُ (من خلال الزر اضافة موظف) تحصل على رسالة خطأ moh_Unique_Code.xlsm

تفضل -يمكنك استخدام هذه المعادلة فى التنسيقات الشرطية =TRIM(MID(B6,IFERROR(FIND("رخام",B6,1)+0,1),9^9))="رخام" تلوين1.xlsx

وعليكم السلام ... ولكن ما تطلبه كثير جداً وليس بالسهل او الهين !!!!!!!!!!!!

السلام عليكم ورحمه الله وبركاته مرفق طيه برنامج صلاحيات المستخدمين الإصدار 3 حيث تم زيادة بعض الخصائص به تتيح حريه اكبر في التعامل مع الملف وقبل اى شيء فلولا أساتذة هذا المنتدى العظيم ما كان لهذا البرنامج ان يظهر او يتطور فمنهم وجدت الدعم ومنهم تعلمت ولا زلت طالبا مبتدئا انهل من علمهم الغزير وفقهم الله وبارك في جهدهم وجعله علم صالح ينتفع به --- اللهم امين اسماء الدخول على البرناج الدعم الفنى - كلمه السر 1111 مستخدم 1 - كلمه السر 2222 شرح بسيط للبرنامج وامكانياته وما هو الجديد عليه تعتمد فكرة البرنامج على اضافه عدة مستويات للصلاحيات على الملف فهو كقالب تقوم بادراج الصفحات التي ترغب بادراتها فيه ويتعرف عليها تلقائيا بمجرد إعادة فتح الملف المستخدم باسم الدعم الفني هو الادمن لهذا الملف وقد تم ربط كافه الصلاحيات بالباسورد الخاصه به مستوى الصلاحيه على الصفحه 4 مستويات مشاهدة فقط ---- للاطلاع فقط دون التعديل مخفى ---- لاخفاء الصفحه عن هذا المستخدم مدخل بيانات - لتحديد أعمدة معينه يتم التعديل عليها وباقى المستند غير متاح وذلك من خلال وضع حرف T في اول خليه اعلى العمود كما يابصفحه 2 وجرب الدخول بالمستخدم 1 ستحلاظ ان صفحه واحد للمشاهدة فقط وصفحه 2 تم تحديد صفه مدخل بيانات ويتم التعديل فقط فى الاعمدة التى تعلوها حرف T ويمكنك اخفاء هذا الضف عن اعين المستخدم ويعمل بشكل طبيعي مشاهدة وتعديل -- هي صلاحيات كامله على الصفحه يمكنك تحديد اى من هذه الصلاحيات لكل صفحه منفصله عن الأخرى لكل مستخدم بصورة منفصله وذلك من خلال الاتى في شاشه الدخول ضع الدعم الفني واكتب كلمه السر وهى 1111 ولا تضغط دخول اى ستجد ان ازار تم تفعليها - اضغط على زر تعديل صلاحيات واختار المستخدم من الكومبوبكس وستجد صلاحياته تظهر اسفل منها افتح كل قائمه وحدد الصلاحيه التي ترغبها لكل مستخدم مع مراعاة ان تكون كلها مشاهدة وتعديل للمستخدم الدعم الفنى يظهر اسفل الفورم اربعه اختيارات وهى الجميع مخفى - الجميع مشاهدة وتعديل - الجميع مشاهدة فقط - الجميع مدخل بيانات ( هذه الاختيارات فقط لتساعدك في ملىء صلاحيات الصفحات حيث تختار ما يغلب على الصلاحيه للمستخدم وتقوم بتعديل الاستثناء فقط مع ملاحظه انه لا يتم التفعيل الا بعد الضغط على زر الحفظ وفى حاله الضغط على زر اضافه مستخدم جديد فانه يجب أولا تسجيل الاسم وكلمه السر الافتراضيه والضغط على زر اضافه مستخدم سيفتح فورم إعطاء الصلاحيات ومن ثم تحدد كما بالخطوة السابقه ملحوظه - كلمات السر يجب ان تكون ارقام فقط - حيث وضع هذا الشرط لعدم تعقيد كلمه السر والدخول في حساسيه الحروف واللغه -- وهكذا يظهر زر اخر فيه تعديل بيانات المستخدمين وحيث يمكنك تعديل اسم مستخدم او حذفه من البرنامج كما يمكنك اظهار أسماء المستخدمين وكلمات السر من خلال وضع علامه صح وسيظهر شاشه لادخال كلمه السر وهنا ضع كلمه سر الدعم افنى سيظهر كومبوبكس فيه أسماء المستخدمين وكلمات السر بجانب كل منهم كل هذه الأشياء يتم التعامل معها قبل الدخول على البرنامج من الشاشه الافتتاحيه وبعد الدخول الى البرنامج توجد بعض الخصائص امكانيه تعديل كلمه السر للمستخدم التنقل بين الصفحات من خلال زر التنقل يقوم البرنامج بعمل حفظ تلقائي عند الخروج حتى لو لم تقوم بالحفظ ما هو الجديد في هذا الإصدار زر صلاحيات اضافيه وفيه الخصائص التاليه امكانيه احضار صفحات من خارج الملف وارفاقها امكانيه نسخ الصفحات المضافه وحفظها في ملفات منفصله لكل منها حذف الصفحات من الملف ترتيب الصفحات تصاعديا وتنازليا فك حمايه المستند وتفعيل الحمايه اظهار واخفاء اشرطه الأدوات للاكسيل المثال المرفق : مستخدم 1 بكلمه سر 2222 صلاحياته هي صفحه رقم 1 مشاهده فقط صفحه رقم 2 - مدخل بيانات -- يمكن الكتابه فقط في الاعمدة التي في اعلاها حرف T صفحه رقم 3 مشاهدة وتعديل باقى الصفحات من 4 الى 7 مخفيه عن مستخدم 1 والكل يظهر مع مستخدم الدعم الفني يجب مراعاة ان صفحه MYDATE يجب ان تكون مخفيه عن جميع المستخدمين نظرا لانه يتم تخزين أسماء المستخدمين وكلمات السر والصلاحيات على الصفحات في هذه الصفحه تلاحظ ان يتم تحديد صفحه MYACCOUNT بصفه مخفى ولكنها تظهر مع المستخدم العادى وذلك فقط اذا حددتها مشاهدة وتعديل فانك ستعطى لهذا المستخدم صلاحيه اضافه مستخدم جديد فقط دون باقى صلاحيات الدعم الفني التي تكون في الفورم الرئيسي برنامج صلاحيات المستخدمين اصدار 3.rar

برنامج محاسبي دقيق جداً لكنه يحتاج إلى خبراتكم وتعليقاتكم حتى أتمكن من تطويره لأفضل درجة ممكنة يعتمد هذا البرنامج في بيئته على جداول الإكسيل ، ويعتمد على فورم واحد فقط يمكنك هذا الفورم من إدخال حسابات الأستاذ الرئيسية وإلحاق الحسابات المساعدة لها إدخال قيود اليومية قيد قيد وترحيلها بضغط زر فقط بمنتهى الدقة الإستعلام عن أي حساب أستاذ وأرصدته من خلال صفحة إستدعاء مخصصة لحسابات الأستاذ الأستعلام عن أي حساب مساعد وبياناته من خلال صفحة مخصصة لذلك ترصيد الحسابات المساعدة في حالة كثرة البيانات في حالة أي إستفسار برجاء التواصل على رقم الهاتف 00201201792967 كما يسعدني تلقى تعليقاتكم وإقتراحاتكم محمد غزال _ القاهرة 30 / 11 / 2013 ACCOUNTANT.rar