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

السلام عليكم .. الاخوة الافاضل الموضوع حول فكرة سريعة لحماية البرنامج عند توزيعه وضمان توافقه مع جهاز العميل قد لا يعرفها الكثيرين , كما نعلم ان افضل طريقة لحماية البرنامج عن طريق تحويله الى ACCDE بالطبع لا يوجد حماية مثالية ولكنها الافضل حالياً , ولكن لكى تعمل نسخة ACCDE على جهاز العميل يجب ان تكون نواة اصدار الاوفيس الخاص به مثل الجهاز الذى قام بتحويل القاعدة الاساسية فإذا كان جهاز المصمم X64 يجب ان يكون جهاز العميل كذلك , الفكرة حول تخطى هذه العقبة . أولا اذا كان برنامج يحتوى على وحدات نمطية Modules يجب ان تتبع طريقة استاذنا @jjafferr فى جعل اكوادك تعمل على النواتين X64 & X86 من هنا : ننتقل للخطوة التالية وهى كيف نتأكد ان البرنامج سيعمل عند العميل ( يجب ان تكون نواة اصدار الاوفيس الخاص به مثل الجهاز الذى قام بتحويل القاعدة الاساسية فإذا كان جهاز المصمم X64 يجب ان يكون جهاز العميل كذلك , الفكرة حول تخطى هذه العقبة ) سنستفيد من جهاز العميل نفسه لتحويل القاعدة الى ACCDE وبالتالى ما سيتم اعطاؤه للعميل هى النسخة الAccdb وسيتم تحويلها على جهازه عن طريق قاعدة اخرى "Converter.Accdb" بها كود تحويل وهو كما يلى : Function Amr() Dim sourcedb, targetdb, nametargetdb As String Dim SDest, SFile, SFName As String SDest = CurrentProject.Path SFile = "MyProgram.Accdb" SFName = SDest & "\" & SFile sourcedb = SFName targetdb = SDest & "\" & "Ready.accde" nametargetdb = SDest & "\" & "Amr.accde" Dim accessApplication As Access.Application Set accessApplication = New Access.Application With accessApplication .SysCmd 603, sourcedb, targetdb End With Kill sourcedb Name targetdb As nametargetdb FollowHyperlink nametargetdb DoCmd.Quit End Function سنستفيد من برنامج Winrar لتحزيم البرنامج وتحويله الى EXE (ابحث فى المنتدى ستجد الكثير من المواضيع المتعلقة) وفى اعدادات التحزيم سنحدد القاعدة Converter.Accdb لتفتح بعد الانتهاء من فك الضغط وبالتالى عند الانتهاء من فك الضغط ستفتح القاعدة التى بها كود التحويل لتحويل برنامجك الى Accde , وفى الفورم الرئيسى لبرنامجك ضع هذا الكود لحذف قاعدة التحويل لمحو اثار الجريمة 😂 Public Function KillConverter() Dim SDest, SFile, SDlt As String SDest = CurrentProject.Path SFile = "Converter.Accdb" SDlt = SDest & "\" & SFile If Len(Dir$(SDlt)) > 0 Then Kill SDlt End Function استدعيها عن حدث فتح النموذج الرئيسى On Open KillConverter وبكده حولنا القاعدة الاساسية الى ACCDE ومسحنا قاعدة التحويل , قد يسأل البعض ماذا لو قام العميل بفك الضغط بدلا من تثبيت البرنامج 😅 فى هذه الحالة سيحصل على النسخة ACCDB وتفشل الخطة , فى هذه الحالة يمكن اضافة هذا الكود الى النموذج الرئيسى فى برنامجك Private Sub Form_Open(Cancel As Integer) Dim appPath, AppName, AppExt As String appPath = Application.CurrentDb.Name AppName = Application.CurrentProject.Name AppExt = Mid(AppName, InStrRev(AppName, ".") + 1) If AppExt = "Accdb" Then MsgBox ("لم يكتمل التثبيت , جارى الخروج"), vbCritical DoCmd.Quit Else DoCmd.OpenForm "Main" DoCmd.Close acForm, "FrmStart" End If End Sub وظيفة الكود هو التحقق من امتداد البرنامج ولن يعمل اذا كان ACCDB وبهذا ضمنت انه يمشى بالخطوات المحددة . ملاحظات عامة : يجب ان تكون قاعدة التحويل فى Trusted Location حتى تعمل بدون مشاكل وهذا هو الشئ الوحيد الذى سنطلبه من العميل وهو اضافة مسار ما الى الاماكن الموثوقة وليكن D:\. مرفق البرنامج المراد تحويله + أداة التحويل لتوضيح الفكرة اكثر. دمتم بخير MyProgram.accdb Converter.accdb

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

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

وعليكم السلام اخي @ابو البشر هل هذا ينفعك ؟ مع تغيير اسماء النماذج Dim strForm As String Dim frm As Form Dim fc As Control Dim SS As String If Me.ComboName = "A" Then strForm = "FormA" ElseIF Me.ComboName = "B" Then strForm = "FormB" Else strForm = "FormC" End If Set frm = strForm For Each fc In frm.Controls If fc.ControlType = 104 Then Me.list_2.AddItem (fc.Caption) End If Next fc Set frm = Nothing Me.Requery

السلام عليكم ورحمة الله ...ضع المعادلة التالية فى الخلية M4 =MAX(COUNTIF($D4:$L4;$D4:$L4)) ثم اضغط CTRL + SHIFT + ENTER معا و الا لن تعمل معك المعادلة ثم اسحب بالماوس حتى آخر خلية تريدها

وعليكم السلام 🙂 الخطأ الابسط: عندكم خطأ في اسم الحقل في المعادلة ، يجب ان تكون بالمقلوب: واردت اتاكد ان الكلمات العربية ما قلبت الكود : والخطأ الاكبر: النموذج مرتبط بجدول ، فأي تغيير في بياناته يجعلك تغير بيانات الجدول ، فلما تدخل رقم الهوية (لسبب مؤقت وهو البحث) في حقل مرتبط في الجدول ، فانت تُخبر نظام قاعدة البيانات بأنك في وضع تعديل: . . فالطريقة الصحيحة ان يكون عندك حقل غير مضمن للبحث ، هكذا مثلا: . ثم تستعمل هذا الكود على حدث "بعد التحديث" Private Sub srch_Card_AfterUpdate() Dim X As Long Dim i As String Dim xSplit() As String X = Me.srch_Card.Text 'i = DLookup("[aa] & '|' & [bb] & '|' & [cc]", "BeneficiaryT", "[رقم الهوية]=" & X) i = Nz(DLookup("[الاسم] & '|' & [اسم الاب] & '|' & [العائلة]", "BeneficiaryT", "[رقم الهوية]=" & X), "There_Are_No_Records_Here") If i <> "There_Are_No_Records_Here" Then xSplit = Split(i, "|") i = xSplit(0) & " " & xSplit(1) & " " & xSplit(2) MsgBox "رقم الهوية" & " ( " & X & " ) " & " تم تسجيله مسبقاُ" & "بأسم" & " " & i, vbCritical, " تنبيه" Me.card.SetFocus DoCmd.FindRecord X, , , , , , True DoCmd.GoToControl "srch_Card" Me.srch_Card.SetFocus Else MsgBox "لا يوجد سجل لهذه الهوية", vbCritical, " تنبيه" Exit Sub End If End Sub . وتلاحظ اني لم استدعي البيانات من الجدول 3 مرات باستعمال 3 اوامر Dlookup ، وانما استدعيتها مرة واحدة (هذا جدا مهم خصوصا لما تكون قاعدة بياناتك مقسمة وعلى السرفر ويستعملها اكثر من مستخدم ، فيجب ان تقلل من زياراتك للجدول ، حتى تخفف العبء عليها وعلى الشبكة) 🙂 جعفر

جربته على أكثر من نسخة وهو يعمل بشكل جيد .. ولعل الإخوة يفيدوننا إن كان الملف يعمل معهم أم لا ؟

السلام عليكم ورحمة الله اليك الملف new-2.xlsm

You have to delete the shapes in your file and insert Oval shapes as I shown you Then press Alt+ F11 to login VBE editor and from Insert menu select Module then copy and paste the code I posted Back to the worksheet and press Alt + F8 and select the macro name and finally click Run

السلام عليكم 🙂 برامج الاكسس ممكن ان يصيبها العطب corruption لعدة اسباب ، وبرامج تصليح العطب يجب ان تكون من ضمن مكتبة برامج المبرمج 🙂 يُعتبر برنامج DataNumen Access Repair من احد البرامج المهمة في اصلاح ملفات الاكسس المعطوبة ، والآن الشركة تعطي النسخة الاحدث 2.9 للإستعمال الشخصي الغير تجاري ، مجانا ، من موقعهم : https://www.datanumen.com/access-repair/ انزلته وجربته ، بس لاحظت ان البرنامج بطيء بالمقارنة مع بعض البرنامج الاخرى ، ولكن لا تنسى أنها نسخة مجانية (للإستعمال الشخصي الغير تجاري) 🙂 جعفر رجاء استعمل رابط الشركة حتى تنزل آخر نسخة هناك ، بينما ارفق هنا النسخة 3 (احتياطا ، اذا غيرت الشركة رأيها لاحقا والغت النسخة المجانية ، فتكون عندنا هنا النسخة المجانية 🙂 ) daccr.zip

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

نعم استاذي الكريم .... هو المطلوب .... بارك الله فيكم اساتذتي الكرام @أبو عبدالله الحلوانى و @Eng.Qassim جزاكم الله خيرا وكتب اجركم ...

أستاذي @Eng.Qassim جزاك الله خيرا لحسن ظنك بي منّ الله علي وعليكم بستره الجميل أخي @ابو البشر جرب هذا ارجو ان يكون هو مطلوبك رجاءا وافنا بالنتائج DDD.accdb

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

دائما نستفيد منكم استاذنا وشكرا على المعلومات القيمة .. بخصوص سؤالك بالفعل بيتم حذف القاعدة الاصلية وستجدها فى الكود هنا فى كود التحويل End With Kill sourcedb وياريت حضرتك ترفقلنا الاسكريبت حتى نستفيد .. جزاكم الله خير قدرك عالى استاذنا الفاضل اغلب ما تعلمناه كان منكم .. جزاكم الله خير تحت امرك

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

اخي ابو حسان 🙂 هل هذه الاسئلة الاخيرة لها علاقة بموضوع صلاحيات المستخدمين ؟ اذا لم تكن ، فرجاء افتح لها موضوع جديد 🙂 جعفر

السلام عليكم أولا- جزاكم الله خيرا حياكم الله وبياكم ثانيا- لو تسمح لي ببعض الملاحظات لتحسين آسف لاثراء تلك الفكرة. 1- وماذا عن قاعدة البيانات accdb اين ستذهب بعد التحويل؟! يجب ان يوضع في الاعتبار حذف القاعدة بعد التحويل. 2- برنامج الضغط جميل وسهل الاستخدام ولكن هنالك ما هو أقوي منه بهذا المجال - أعني تحزيم ملفات البرنامج، مثل: برنامج Smart Install Maker فهو برنامج سهل الاستخدام قوي المفعول يحول برنامج التحزيم الي صيغة exe ويتيح لك العديد من خيرات التسطيب علي جهاز العميل 3- عوضا عن استخدام كود التحويل بقاعدة بيانات اكسس ايضا وتحتاج الي مزيد من الاجراءات كايقاف الأمان لكي تعمل او وضعها بفولدر موثوق - كمن استعان بالرمضاء من النار يمكنك ان تضع كود التحويل داخل اسكربت يتم تشغيله تلقائيا اثناء عملية التسطيب وبعد استخراج ملف القاعدة بفولدر التسطيب ويتم ازالتها وازالة الاسكربت بعد الانتهاء من عملية التحويل الي accde وانتهي الأمر بسلام ولا خوف من استخراج الملفات قبل التسطيب مثل برنامج رار فانه غير ممكن استخراج الملفات الا اثناء عملية التسطيب فقط ودمتم هكذا بحار العلم لا يضرها من اقتبس منها المشرب ثم وان كانت مفتوحة المصدر فهي السهل الممتنع علي تلاميذ مدرستكم وجزاكم الله عنا خيرا

🤣🤣 شكرا استاذ عمر على المعلومات ..

وعليكم السلام ورحمة الله وبركاته جرب هذا التعديل Set frm = currentproject.AllForms(frm_name) استبدل كلمة frm_name باسم الست بوكس متبوعا برقم الحقل الذي يحوي اسماء النماذج لا تنسي موافتنا بالنتائج

تمام استاذي @الفلاحجى فهناك ممن يبحث عن هكذا موضوع .. جزيت خيرا

طريقة رائعة جدا وإبداعية في نفس الوقت .. لله دركما 😃🌹

شغال زيه الفل استاذ موسى يمكن هو ماخدش باله من طريقه التشغيل جزاك الله خيرا عالعموم اضع له طريقه اخى واستاذى العزيز خالد @kha9009lid الغائب عن العين الحضر فالقلب مع جميع اخوانى واخواتى الذيت تعلمت واتعلم منهم كل يوم جزاهم الله عنا كل خير وهى تصفيه القائمه بمجرد الكتابه بالكمبو بالتوفيق اخوانى kids(2).accdb

عندك خطأين واحد فالجدول IETEM_NEM بانك جعلت الحقل ITEM_NO نص طويل حولها لنص مختصر ثانيا فالكود فالسطر الاخير لم تغير Me!ID Me!id = "bw/" & prtyr & "-" & Format(xNext, "00000") فغيره الى Me!ITEM_NO = "bw/" & prtyr & "-" & Format(xNext, "00000") بالتوفيق

اخي مصطفى ، بالله عليك ، هل تستطيع انت ان تقرأ المعلومات اللي في الصورة التي ارفقتها !! ساعدنا حتى نساعدك !! حسب من استطعت قراءته ، الرسالة تقول ، ان الحقل/الكائن Exp1 غير موجود في النموذج ، فتأكد من الاسم 🙂 فوائد الماكرو : 1. في الاكسس 2010 ، عملت مايكروسوفت على جعل الاكسس يعمل في الانترنت ، ولكنه كان يقبل الماكرو فقط (وبعدين وبعد ان شافوا قوته وكثرة تهافت المبرمجين عليه ، اوقفوه حتى يستعملون برامج مايكروسوفت الاخرى والمخصصة لصفحات الانترنت ، وطبعا قواعد البيانات SQL Server ) ، 2. في بعض الشبكات ، يتم وقف اكواد VBA ، وفقط يمكنك استعمال الماكرو في عملك (لأن الكثير الفايروسات وبرامج التخريب تعمل بلغة VBS وهو مشابه لـ VBA ، فالشبكات توقفه) ، 3. الماكرو سهل في التعامل معه ، فقط نحتاج الى ممارسة 🙂 جعفر

السلام عليكم ورحمة الله اخى الكريم المعادلة تكون هكذا =IF(OR(U10<25;T10<5;T10="غ");"لغة عربية ";"")

جرب الشرح هذا https://youtu.be/QmoeXhOiMuo

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim x, sh As Worksheet, r As Long, c As Long, n As Long, m As Long Set sh = Sheets(2) If Target.Address = "$L$8" Then Application.ScreenUpdating = False Application.EnableEvents = False Range("J11:T20").ClearContents r = 11: c = 10 For n = 2 To sh.Range("B" & Rows.Count).End(3).Row If sh.Range("B" & n) = Target Then Cells(r, c) = sh.Range("C" & n) r = IIf(c = 18, r + 1, r): c = IIf(c = 18, 10, c + 2) End If Next n Application.EnableEvents = True Application.ScreenUpdating = True ElseIf Target.Column = 11 Or Target.Column = 13 Or Target.Column = 15 Or Target.Column = 17 Or Target.Column = 19 Then x = Application.Match(Range("L8").Value & Target.Offset(, -1).Value, sh.Columns(6), 0) If Not IsError(x) Then If Target.Value > sh.Cells(x, 5).Value Then MsgBox "Amount Is Less Than The Available Amount In Stock" & vbCrLf & "The Amount In Stock = " & sh.Cells(x, 5).Value, vbExclamation Application.EnableEvents = False Target.ClearContents Application.EnableEvents = True End If If Target.Value = sh.Cells(x, 5).Value Then MsgBox "Pay Attention! You Entered All The Amount In The Stock", vbInformation End If End If m = Range("B" & Rows.Count).End(xlUp).Row + 1 x = Application.Match(Target.Offset(, -1), Columns(2), 0) If Not IsError(x) Then Cells(x, 6) = Cells(x, 6) + Val(Target.Value) Else Cells(m, 2) = Target.Offset(, -1) Cells(m, 6) = Target.Value End If End If End Sub Before copy and paste the code, put the following formula in the second sheet in F2 and drag down =B2&C2 The hide column F in the second sheet as this is a helper column

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

جزاكم الله خيرا وصلني حقي

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

اتفضل اخى ومعذره فقمت باستيراد النماذج والجدول الى قاعده بيانات اخرى قمت بعملها فى كمبو واحد ان شاء الله يكون ما تريد Private Sub naked1_AfterUpdate() Me.Subfrm!naked1 = Me.naked1 End Sub بالتوفيق Database1.accdb

السلام عليكم ورحمة الله تم ربط الورقة الثانية بالورقة الاولى كما طلبت ...اما عملية توزيع الاحتياطى بالعدل اتمنى و استعطت ان ارسلها فى مشاركة لاحقة,,,اليك الملف اللجان والملاحظة.xlsx

تفضل هذه المشاركة اضغط على استعلام نقل البيانات فقط Public Function TransData() Dim db As DAO.Database, Tb1 As DAO.Recordset, Tb2 As DAO.Recordset If DCount("*", "التجهيز") > 0 Then If MsgBox("توجد بيانات جاهزة للترحيل" & vbNewLine & vbNewLine & "هل تريد ترحيل البيانات الآن ؟" _ , vbExclamation + vbYesNo + vbMsgBoxRight, "تأكيد") = vbYes Then Set Tb1 = CurrentDb.OpenRecordset("التجهيز"): Tb1.MoveFirst: Set Tb2 = CurrentDb.OpenRecordset("الاساسي") While (Not Tb1.EOF) Tb2.AddNew Tb2.Fields("م").Value = Nz(DMax("م", "الاساسي"), 0) + 1 Tb2.Fields("الاسم").Value = Tb1.Fields("الاسم") Tb2.Fields("الرقم").Value = Tb1.Fields("الرقم") Tb2.Fields("المبيعات").Value = Tb1.Fields("المبيعات") Tb2.Fields("رقم المستند").Value = 1 Tb2.Fields("تاريخ المستند").Value = Format(Now, "yyyy/mm/dd") Tb2.Update Tb1.MoveNext Wend If MsgBox("تم نقل البيانات بنجاح" & vbNewLine & vbNewLine & "هل تريد حذف البيانات من جدول التجهيز ؟" _ , vbQuestion + vbYesNo + vbMsgBoxRight, "تأكيد") = vbYes Then Tb1.MoveFirst While (Not Tb1.EOF) Tb1.Delete Tb1.MoveNext Wend MsgBox "تم حذف بيانات جدول التجهيز بنجاح", vbInformation + vbMsgBoxRight, "تأكيد" Else End If Tb1.Close: Set Tb1 = Nothing End If End If End Function 5.accdb

تفضل أخي العزيز .. لديك فورم للترحيل تدخل فيه رقم وتاريخ المستند .. ثم ترحل البيانات .. زر الترحيل يشغل لك استعلامين .. الأول إلحاقي .. والثاني حذف ( يحذف البيانات من الجدول) الكود على زر الترحيل : Private Sub TarheelBtn_Click() Dim Count As Integer If IsNull(Me.DocDatetxt) Or IsNull(Me.DocNumtxt) Then MsgBox "يرجى تعبئة البيانات قبل الترحيل": Me.DocNumtxt.SetFocus: Exit Sub Count = DCount("*", "[التجهيز]") If MsgBox("هل ترغب في ترحيل " & Count & " سجلات ؟", vbExclamation + vbYesNo, "تحذير !") = vbYes Then DoCmd.SetWarnings False DoCmd.OpenQuery "AttachQ", acViewNormal DoCmd.OpenQuery "DeleteQ", acViewNormal DoCmd.SetWarnings True MsgBox "تم الترحيل بنجاح" Else Exit Sub End If End Sub الملف بعد التطبيق : استعلام ترحيل البيانات.accdb

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

اخر عمليه في الملف المرفق ولا ملف اخر

Use the oval shapes from Insert tab > Illustrations > Shapes > Oval. Then use this code Don't forget to change the range to suit your range Sub Test() Dim x, c As Range, r As Long, y As Long, g As Long, b As Long Application.ScreenUpdating = False r = RGB(255, 0, 0): y = RGB(255, 255, 0) g = RGB(0, 176, 80): b = RGB(0, 112, 192) For Each c In Range("C8:F11") Set x = FindImage(c) If Not x Is Nothing Then If c.Value = 1 Then c.Font.Color = r: x.Fill.ForeColor.RGB = r ElseIf c.Value = 2 Then c.Font.Color = y: x.Fill.ForeColor.RGB = y ElseIf c.Value = 3 Then c.Font.Color = g: x.Fill.ForeColor.RGB = g ElseIf c.Value = 4 Then c.Font.Color = b: x.Fill.ForeColor.RGB = b End If End If Set x = Nothing Next c Application.ScreenUpdating = True End Sub Function FindImage(CellToCheck As Range) As Shape Dim wShape As Shape, addr addr = CellToCheck.Address For Each wShape In CellToCheck.Parent.Shapes If wShape.TopLeftCell.Address = addr Then Set FindImage = wShape: Exit Function Next wShape End Function

اخي ابا جودي شكرا لك لمرورك العطر و جمعة مباركة عليك و على الجميع بالنسبة لأماكن الأزرار فقط استخدمت Controls().Move لا اكثر و لا اقل مع تحديد الموضع و زيادة المسافة من الأعلى داخل الحلقة التكرارية Forms!Form1.Controls(mycomnd).Move

تفضل التعديل صلاحيات كاملة صلاحيات حسب الاختيار الدائن و المدين.zip

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

تفضل جرب المرفق رواتب معدل.xlsx

وعليكم السلام ورحمة الله وبركاته جرب هذا البرنامج وادعو لاستاذنا جغفر صاحب الموضوع تحياتي