عبدالله بشير عبدالله

وعليكم السلام ورحمة الله وبركاته جرب التعديل التالي حسب ملفك المرفق اعداد الحجم الملائمة الى 1 عرضا - 1 طولا قم بالتاشير على الخيار الاول الضبط الى

السلام عليكم ورحمة الله وبركاته حسب فهمي لمشكلة عدم الحفظ السبب ان امنداد ملفك xlsx (المقصود بالامتداد يكون بعد اسم الملف) هذا النوع من الامتداد لا تحتفظ بالأكواد (مثل أكواد VBA) لأنها مصممة فقط لتخزين البيانات والصيغ والرسومات — ولكن دون دعم للماكرو أو الأكواد البرمجية. انواع الامتداد التي تحتفظ بالاكواد xlsm - xlsb او xls لاصدار 2003 او اقل قم بوضع الكود في ملقك ثم اختر ملف ثم حفظ باسم واختار اما xlsm او xlsb ثم احفظ الملف على سطح المكتب مثلا قم بفتح الملف الجديد الذي قمت بحفظه وليس الاول ستجد الكود بداخله اليك مثال لاحظ الامتداد New Microsoft Excel Worksheet.xlsb هذا حسب فهمي لطلبك وان كان ما دكرته ليس المطلوب فاوضح اكثر

اخونا الفاضل لا يمكن حل المشكلة من خلال صورة بدون ملف مرفق يبقى مخاولات تخطى وتصيب بالنسبة لهذه الصورة قم بالدخول الى محرر الاكواد وطبق خسب الصور قم بالغاء التاشير على اي شئ بدايته missing اذا لم يتجح الامر قم برقع ملفك لمعرفة المشكلة اما الصورة الاخرى هذا الخطأ يظهر في Excel VBA عندما تحاول استخدام كائن (مثل ورقة عمل أو عنصر تحكم أو كائن Word) دون أن تكون قد قمت بتعيينه أو تعريفه بشكل صحيح وهذا يحتاج الى ارفاق الملف او الكود لمعرفة الخطا والله اعلم

السلام عليكم حسب فهمى لطلبك وبدون ارفاق ملف منكم اليك الكود Sub RunMacroWithPassword() Dim password As String Dim userInput As String password = "1234" userInput = InputBox("من فضلك أدخل كلمة السر لتشغيل الماكرو:", "كلمة السر") If userInput = password Then MsgBox "كلمة السر صحيحة، سيتم الآن تشغيل الماكرو.", vbInformation Call MyProtectedMacro Else MsgBox "كلمة السر غير صحيحة. لن يتم تشغيل الماكرو.", vbCritical End If End Sub Sub MyProtectedMacro() MsgBox "تم تشغيل الماكرو بنجاح!", vbInformation ' أضف الكود الحقيقي هنا... End Sub الكود الاول Sub RunMacroWithPassword() وفيه المطالبة بكلمة السر وهي 1234 والكود الثاني Sub MyProtectedMacro() وهو الذي سيتم تنفيذه بعد وضع كلمة السر مثال تنفيذ ماكرو مع ادخال كلمة سر.xlsb

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

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

والملف المرفق السابق التنسيق في عمود الحالة كما في طلبك الجديد العمود B وان اردت التعديل فحدد اي عمود يكون به التنسيق تحياتي

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

وعليكم السلام ورحمة الله وبركانه اليك الملف وبه التعديل ترحيل بيانات الموظف المحال للمعاش إلى شيت آخر وحذفه من قاعدة البيانات 5.xlsb وان اردت اي تعديل في الملف فايشر لك كل الود والاحترام

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

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

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

وعليكم السلام ورحمة الله وبركانه الكود يقوم بفرز الاسماء المكررة ويضعها في العمود C Sub تجميع() Dim ws As Worksheet Dim lastRow As Long, i As Long, j As Long Dim dict As Object Dim name As Variant, location As String Dim outputRow As Long Set ws = ActiveSheet Set dict = CreateObject("Scripting.Dictionary") lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row For i = 1 To lastRow name = ws.Cells(i, 1).Value location = ws.Cells(i, 2).Value If name <> "" Then If dict.Exists(name) Then dict(name) = dict(name) & " / " & location Else dict(name) = location End If End If Next i ws.Range("C1:D" & ws.Rows.Count).ClearContents outputRow = 1 For Each name In dict.Keys ws.Cells(outputRow, 3).Value = name ws.Cells(outputRow, 4).Value = dict(name) outputRow = outputRow + 1 Next name End Sub Book2.xlsb

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

تم التعديل استمارة الكترونية1.xlsm

السلام عليكم حسب التجربة الكود يعمل جيدا ولا يحتاج الى تعديل ويعطى نتائج كما في طلبك شاهد المرفق بعد حذف ارتباط ملفك بملفات اخرى 1تفقيط الرقم.xlsm وان كنت تقصد شئ اخر فاوضح اكثر كما لا تتسى ان تنقدم بالشكر لصاحب الكود معلمتا الاستاذ عبدالله باقشير من اليمن السعيد صاحب المساهمات القيمة في تطوير أدوات Excel باستخدام VBA، حيث قام بإنشاء العديد من النماذج والملفات التي تساعد المستخدمين في تنفيذ مهامهم بشكل أكثر كفاءة فجزاه الله كل خير وجعل ما قدمه في موازيين حسناته

وعليكم السلام ورحمة الله وبركاته الطريفة الاولى قبل حفظ الملف ارجع الى الصفحة الرئيسية ثم حفظ الطريقة الثاتية عن طريق كود وسيقوم بفتح الصفحة الرئيسية حتى لو قمت بالحفظ عند ورقة 10 مثلا ضع هذا الكود في محرر الاكود في ThisWorkbook Private Sub Workbook_Open() Sheets("SHEET1").Activate End Sub طبعا غير اسم SHEET1 بالكود باسم الشيت الرئيسى لديك

وعليكم السلام ورحمة الله وبركاته تم تعديل المعادلات ليكون ارتباطها بالخلية N9 فقط في صفحة استدعاء ومن ضمنها الاعمدة المخفية D & K مع تعديل طفيف بالكود bac test1.xlsm

وعليكم السلام ورحمة الله وبركاته عذرا الملف لا يوجد به اي كود وهو مرتبط بملف اخر موجود على جهازك

ما شاء الله ايداع جزاك الله خيرا

الملف في الرد السابق

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

وعليكم السلام ورحمة الله وبركاته ارفق ملفك وابشر خيرا

وعليكم السلام ورحمة الله وبركاته اليك الملف واستبدله في مجلد جمع الفواتير الكود يتعامل مع اي عدد من الملفات امتدادها XLSM حسب ملفاتك المرفقه ويمكن تعديلها بالكود ان نغير الامنداد جرب الملف واعلمنى بالنتائج جمع.xlsm

وعليكم السلام ورحمة الله وبركاته جرب الكود وان كان يحتاج الى تعديل اعلمنى بالامر __نسخة aaaa_.xlsb