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

1-سبق و قلت لك في موقع اخر الاسماء بسيطة و غير معقدة ( التفتيش عن اسم بسيط للتأكد من عمل الماكرو يصبح امراً سهلاً) و اذا نجح الماكرو تضعيتن الاسماء التي تريدينها 2- اي شيت تريدين ان يشمله الماكرو يجب ان يحتوي اسمه على "_" "Under Score" كما في الملف المرفق 3- لا لزوم لأعداد كبيرة 1458.1587 في البداية فقط يكفي اعداد بسيط من 1 الى 10 للتأكد من عمل الماكرو و اذا نجح الماكرو تضعيتن الأرقام التي تريدينها 4 - لا حاجة لأربع صفحات لاخنبار الماكرو (يكفي صفحتين) و اذا نجح الماكرو تضعيتن ما تريدين من صفحات Option Explicit Sub My_Total() Rem Created By Halim Hasbaya On 15/7/ 2020 Dim Main As Worksheet Dim sh As Worksheet Dim arr(), m%, itm, x%, k% Dim Ro%, S#, ky Dim Dic As Object Application.ScreenUpdating = False m = 1 Set Main = Sheets("SUMOLL") Main.Range("a2").Resize(10000, 2).Clear Set Dic = CreateObject("Scripting.Dictionary") For Each sh In Sheets If InStr(sh.Name, "_") Then ReDim Preserve arr(1 To m) arr(m) = sh.Name m = m + 1 End If Next If m = 1 Then GoTo Thank_You For Each itm In arr Set sh = Sheets(itm) Ro = sh.Cells(Rows.Count, 1).End(3).Row For x = 2 To Ro - 2 Step 2 S = Application.Sum(sh.Cells(x + 1, 2).Resize(, 5)) Dic(sh.Cells(x, 1).Value) = Dic(sh.Cells(x, 1).Value) + S Next x Next itm k = 2 If Dic.Count = 0 Then GoTo Thank_You For Each ky In Dic.keys With Main.Cells(k, "A") .Value = ky .Offset(1) = "TOTAL" .Offset(1).Resize(, 2). _ Interior.ColorIndex = 20 .Offset(1, 1) = Dic(ky) End With k = k + 2 Next ky With Main.Range("A" & k + 1) .Value = "All Sum" .Offset(, 1).Formula = _ "=SUM(B2:B" & k - 1 & ")" .Resize(, 2).Interior.ColorIndex = 8 End With With Main.Range("A2:B" & k + 1) .Borders.LineStyle = 1 .InsertIndent 1 .Value = .Value With .Font .Size = 14: .Bold = True End With End With Thank_You: Set Main = Nothing: Set sh = Nothing Set Dic = Nothing: Erase arr Application.ScreenUpdating = True End Sub الملف مرفق(عدد 2) الأول حسب رغبتك والثاني ما أراه مناسباً اختاري ما تريدين (مع ابداء الرأي) Yara_data.xlsm Yara_data_1.xlsm

الكود ليس له علاقة بلون التاب فقط يتعاطى مع الشيتات التي اسمها يحتوي على Under score اذا اردتي ان يقوم الماكرة بفحص الشيت الذي اسمه ِAny sheet مثلاً اجعلي اسمه Any_sheet الاسما تدرج جميعها (المكرر مرة واحدة) اذا اردت اضافة اللون الى الشروط يجب اضافة شرط واحد على الكود كما في الصرورة

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

غير نوع الخط الى Arial او اي خط اخر تنتهي المشكلة الشهادات مدرسية1.accdb

ليش المعذرة الامر عادي ياغالي كلنا نحاول بقدر مانستطيع

هذا الملف مع اسماء الشيتات حيث يتواجد كل عنصر مع مجموع كل شيت على حدة Yara_data_With_count.xlsm

المعذرة اخي محمد انزلت الرد اثناء نزول ردك

جرب المرفق الشهادات مدرسية1.accdb

اتفضل الشهادات مدرسية.accdb

السلام عليكم يأخي أنت تريد طباعة حسب الرقم تسلسلي

أشكرك .. وجزاك الله خيرا .. جميل

في مشاركة سابقة للاخ @RAGABFAROUK كان لديه قاعدة بيانات خاصة بعيادة طبية ربما كان يرغب في تزويدك بنسخة منها لكون طلبك لمستشفى خيري ولم يرغب في طرحها بالموقع حفاظ على حقوقة يَا أَيُّهَا الَّذِينَ آمَنُوا اجْتَنِبُوا كَثِيرًا مِّنَ الظَّنِّ إِنَّ بَعْضَ الظَّنِّ إِثْمٌ ۖ وَلَا تَجَسَّسُوا وَلَا يَغْتَب بَّعْضُكُم بَعْضًا ۚ أَيُحِبُّ أَحَدُكُمْ أَن يَأْكُلَ لَحْمَ أَخِيهِ مَيْتًا فَكَرِهْتُمُوهُ ۚ وَاتَّقُوا اللَّهَ ۚ إِنَّ اللَّهَ تَوَّابٌ رَّحِيمٌ اسال الله لي ولكم المغفرة والاجر والثواب

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

هذا المطلوب .. وفقك الله .

السلام عليكم تفضل اخي الكريم ضع هذا الكود من خلال زر في النموذج DoCmd.OpenTable "اسم الجدول", acViewNormal تحياتي

بسم الله والحمد لله.. السلام عليكم يا كرام.. وكتب الله لكم الأجر.. وفاء مع هذا المنتدى العامر، وما له من أفضال وعطاء.. درس طريقة نقل صفوف الجدول بشكل احترافي.. دمتم بخير يا كرام.. https://youtu.be/DcthJ1lX7JA

تم الوصول للحل بفضل الله وهو الضغط على CTRL + SHIFT + ENTER وذلك للدخول كمسئول Administrator بمعنى + CTRL + SHIFT + ENTER كل الشكر والتقدير لاستاذنا الغالي @kanory والأستاذ @حسين العربى

تفضل اخي الكريم المخزن.rar نحياتي

السلام عليكم بعد اذن استاذنا العزيز @محمد أبوعبدالله تفضل اخي الكريم نموذج فيه كود لمسح الحقول ( تاريخ الغياب و حقل ساعة الغياب و سبب الغياب) تحياتي تفريغ حقول معينة من الجدول.rar

محمد مصطفى عثمان تمام أين انت من هذه الإجابة الممتازة ؟!!! أين الضغط على الإعجــــاب ؟!!!💙 وهذا اقل ما يقدم لصاحب الفضل عليك بعد ربنا فى حل مشكلتك وتفريج كربتك , وليس هناك اى داعى للتذكير دائما للجميع فهذا اقل واجب تجاه من قدم المساعدة اليك .. وهل جزاء الإحسان الا الإحسان

السلام عليكم جربها الآن في البئة 64 بيت يجب قبل كلمة Function وضع كلمة PtrSafe لتصبح PtrSafe Function كذلك في bibliothèque إضافة كما في الصورة المرفقة BackUp_Tables.rar

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

تمام اخي الكريم ارغب بهذا الحل, حيث انه سيوفر وقت و مجهود كثير جدا شكرا جزيلا

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

السلام عليكم تفضل اخي الكريم برنامج لفتح او الغاء الشفت للست ام عهود تحياتي برنامج فتح والغاء الشفت بالاكسس.rar

نستكمل سلسلة الدروس ندخل فى مرحله تطبيق ما تعرفنا عليه من خلال الدروس السابقة التطبيقات العملية ( 1 ) الترحيل السؤال الذى يطرح نفسه بعد ما تعرفنا على ما سبق الحديث عنه من الأدوات وبعض المعادلات والمتغيرات والكائنات والمدى والرسائل المستخدمه فى كتابة الأكواد سواء كان داخل موديول أو بحدث الملف ( المصنف ) أو بحدث الصفحه كيف نكتب كود ؟ كيف نستخدم هذه الأدوات ؟ حتى نخرج بكود منسق نستخدمه فى أمر ما رأيت أن نبدأ بالتعرف على كتابة الأكواد التى تستخدم فى أمر الترحيل حتى يكون أول تطبيق عملى نبدأ به للتعرف الملموس على لغة البرمجه داخل الاكسل وسيكون بإذن الله هناك سلسلة كاملة من التطبيقات العملية التى تستخدم فى عده مجالات خلاف الترحيل حتى نتعرف تماما على كيفية استخدام ما ورد بالدروس السابقة والإستفاده منها لذا أتمنى من متابعى هذه الدروس مراجعه ما سبق جيدا حتى يكون الامر سهلا ميسرا ملحوظة هامه جدا :- يجب أن نعرف جيدا أن هناك العديد من الطرق لكتابة كود ما ويكون شكله مختلف عن الكود الآخر ولكن نتيجته واحده فالهدف هنا من تلك الدروس أن نكون على الطريق الصحيح لفهم العملية التطبيقية للإستفاده وليس حصر جميع الاكواد الخاصة بموضوع ما ************************************* نبدأ التطبيق العملى الأول بهذه السلسلة التعليمية في المثال المرفق ستجد ورقتي عمل Invoice " " List" وسيتم إدخال البيانات في الورقه " Invoice " ثم بعد الإنتهاء نضغط على الزر لتنتقل في أماكن محدده بورقة العمل " List " حاليا أهيأ نفسى لكتابة البيانات التى أريدها فى ورقة خارجية يدويا لمعرفة ما هو المطلوب للشكل الذى أريده أتحدث الى نفسى الآن مطلوب منى أو أنا أريد كتابة بيانات خاصة بموظف ما فى شيت ثم ارحل تلك البيانات الى شيت آخر ولكن الشيت الثانى عبارة عن جدول تجميعى لبيانات جميع الموظفين إذن نقوم بعمل الآتى : أولا : نقوم بتحديد الذى نريده حتى تتضح لنا فكرة الترحيل ثانيا : تنسيق شيت الادخال بما يتناسب مع حجم البيانات المطلوبه لترحيلها لشيت الادخال مع توضيح اذا كان هناك بيانات اساسية يجب ادخالها من عدمه ومعرفة الخلايا التى سيتم كتابه البيانات داخلها لجميع خلايا ادخال البيانات وبالنموذج المرفق جميع البيانات يجب ادخالها ليتم الترحيل وسنتعرف على ذلك بالكود والخلايا هى كالتالى ( B3 , D3 , A5 , D6 , B8 , D8 ) ثالثا : تنسيق الشيت الثانى حتى يكون ملائما لشكل جدول تجميعى خاص بجميع الموظفين ويكون معلوم لدينا ان كل خليه ستنتقل الى خليه بعمود معين بترتيب معين أسفل بعض فى كل عمليه ادخال وترحيل بمعنى ان الخلية B3 بشيت الادخال سترحل الى خليه بالعمود B الخلية D3 بشيت الادخال سترحل الى خليه بالعمود C الخلية A5 بشيت الادخال سترحل الى خليه بالعمود D الخلية D6 بشيت الادخال سترحل الى خليه بالعمود E الخلية B8 بشيت الادخال سترحل الى خليه بالعمود F الخلية D8 بشيت الادخال سترحل الى خليه بالعمود G على أن يتم ترحيل كل عملية أسفل بعض بشيت التجميعى أى القائمة التى بها جدول تجميع جميع بيانات الموظفين شكل شيت الادخال شكل شيت تجميع البيانات تبقى لنا هنا كتابة الكود الذى سينفذ ما تخيلته ووضعته فى الشيت بإستخدام ما تعرفنا عليه بالدروس السابقة نبدأ بعون الله بحفظ ما سبق حتى لا يضيع هباء اثر انقطاع التيار أو خلافه ثم نقوم بفتح محرر الأكواد بالضغط على ALT+F11 ثم نقوم بإدراج موديول بالضغط على ادراج أو INSERT ونختار موديول تلقائيا سيتم فتح الموديول وربط الكود بزر للترحيل شكل اجمالى الكود المرفق بالمثال العملى بالموديول 1 كالتالى : Sub MZM_MoveData() Dim EndRow As Long If Sheets("Invoice").Range("B3").Value = "" Or Sheets("Invoice").Range("D3").Value = "" Or Sheets("Invoice").Range("a5").Value = "" Or Sheets("Invoice").Range("D6").Value = "" Or Sheets("Invoice").Range("B8").Value = "" Or Sheets("Invoice").Range("D8").Value = "" Then MsgBox prompt:="تأكد من إدخال كافة البيانات", Title:="خطأ" Else EndRow = Sheets("List").Range("A1").CurrentRegion.Rows.Count Sheets("List").Cells(EndRow + 1, 1).Value = EndRow Sheets("List").Cells(EndRow + 1, 2).Value = Sheets("Invoice").Cells(3, 2).Value Sheets("List").Cells(EndRow + 1, 3).Value = Sheets("Invoice").Cells(3, 4).Value Sheets("List").Cells(EndRow + 1, 4).Value = Sheets("Invoice").Cells(5, 1).Value Sheets("List").Cells(EndRow + 1, 5).Value = Sheets("Invoice").Cells(6, 4).Value Sheets("List").Cells(EndRow + 1, 6).Value = Sheets("Invoice").Cells(8, 2).Value Sheets("List").Cells(EndRow + 1, 7).Value = Sheets("Invoice").Cells(8, 4).Value Sheets("Invoice").Range("B3,D3,A5,D6,B8,D8").ClearContents MsgBox prompt:="تم ترحيل البيانات بنجاح", Title:="رسالة تأكيد" End If End Sub نكتب بداية ونهاية الكود كما أشرنا سابقا البداية بكلمه SUB ثم اسم للكود ثم القوسين المغلقين () والنهاية تلقائيا يتم كتابتها END SUB هنا لدينا عدد معلوم من الخلايا التى ستستخدم كناقل للشيت الآخر اى سيتم تخزينها لدى ذاكرة الجهاز ومن ثم سيتم ترحيلها ووضعها بالشيت الثانى اذا لابد من استخدام متغير داخل الكود ونقوم بوضع اسم لذلك المتغير وهو السطر التالى الموجود بالكود Dim EndRow As Long وضعنا على أنفسنا شرط لترحيل البيانات أو بمعنى آخر نريد أن نجبر المستخدم على ادخال كافة البيانات لكى يتم الترحيل ماذا نفعل ؟ نضع الشرط داخل الكود بالجملة الشرطية التى نستخدم فيها دائما قاعده IF نقول فيها انه فى حاله ادخال كافة البيانات بالخلايا المذكورة If Sheets("Invoice").Range("B3").Value = "" Or Sheets("Invoice").Range("D3").Value = "" Or Sheets("Invoice").Range("a5").Value = "" Or Sheets("Invoice").Range("D6").Value = "" Or Sheets("Invoice").Range("B8").Value = "" Or Sheets("Invoice").Range("D8").Value = "" Then وإلا سنقوم بتنبيه المستخدم أو انا لو نسيت خليه مثلا برساله تظهر لنا "خطأ", Title:= "تأكد من إدخال كافة البيانات" MsgBox prompt:= بخلاف ذلك فى حاله الالتزام بالشرط نفذ التالى _ ( الجزئية الخاصة السابق الحديث عنها أثناء تجهيز وتنسيق شكل الشيتين ) _ .. ولا ننسى انهاء جملة IF Else EndRow = Sheets("List").Range("A1").CurrentRegion.Rows.Count Sheets("List").Cells(EndRow + 1, 1).Value = EndRow Sheets("List").Cells(EndRow + 1, 2).Value = Sheets("Invoice").Cells(3, 2).Value Sheets("List").Cells(EndRow + 1, 3).Value = Sheets("Invoice").Cells(3, 4).Value Sheets("List").Cells(EndRow + 1, 4).Value = Sheets("Invoice").Cells(5, 1).Value Sheets("List").Cells(EndRow + 1, 5).Value = Sheets("Invoice").Cells(6, 4).Value Sheets("List").Cells(EndRow + 1, 6).Value = Sheets("Invoice").Cells(8, 2).Value Sheets("List").Cells(EndRow + 1, 7).Value = Sheets("Invoice").Cells(8, 4).Value Sheets("Invoice").Range("B3,D3,A5,D6,B8,D8").ClearContents "رسالة تأكيد", Title:= "تم ترحيل البيانات بنجاح" MsgBox prompt:= End If شرح الجزئية السابقة : - السطر الأول والثانى البحث عن أول صف فارغ للنقل وجعلنا العمود A مخصص للترقيم بشكل متسلسل تلقائيا مع كل ادخال وترحيل بشيت القائمة - السطر الثالث شيت القائمة الخلية التى بأول صف فارغ بالعمود الثانى تكون قيمته Sheets("List").Cells(EndRow + 1, 2).Value تساوى بشيت الادخال ( Invoice ) قيمة الخلية التى بالصف الثالث والعمود الثانى وذلك حتى نهاية السطر الثامن نلاحظ أن احدى طرق تعريف الخليه بالكود يكون كالتالى ( 8, 4 ) ورقم 8 يعنى الصف ورقم 4 يعنى العمود اى الخلية ( D8 ) - السطر التاسع معناه بعد الترحيل قم بمسح محتوى تلك الخلايا المذكورة - السطر العاشر ظهور رساله تأكيد بنجاح عملية الترحيل سؤال : هل هناك طرق أخرى لكتابه هذا الكود بشكل آخر ؟ الاجابة : نعم فعلى سبيل المثال لا الحصر وفى ضوء ما تم الإشارة اليه بالدروس السابقة Sub MoveData() Set li = ThisWorkbook.Sheets("List") Set inv = ThisWorkbook.Sheets("Invoice") Dim EndRow As Long If inv.Range("B3").Value = "" Or inv.Range("D3").Value = "" Or inv.Range("a5").Value = "" Or inv.Range("D6").Value = "" Or inv.Range("B8").Value = "" Or inv.Range("D8").Value = "" Then MsgBox prompt:="تأكد من إدخال كافة البيانات", Title:="خطأ" Else EndRow = Sheets("List").Range("A1").CurrentRegion.Rows.Count li.Cells(EndRow + 1, 1).Value = EndRow li.Cells(EndRow + 1, 2).Value = inv.Cells(3, 2).Value li.Cells(EndRow + 1, 3).Value = inv.Cells(3, 4).Value li.Cells(EndRow + 1, 4).Value = inv.Cells(5, 1).Value li.Cells(EndRow + 1, 5).Value = inv.Cells(6, 4).Value li.Cells(EndRow + 1, 6).Value = inv.Cells(8, 2).Value li.Cells(EndRow + 1, 7).Value = inv.Cells(8, 4).Value inv.Range("B3,D3,A5,D6,B8,D8").ClearContents MsgBox prompt:="تم ترحيل البيانات بنجاح", Title:="رسالة تأكيد" End If End Sub تم إضافة تخصيص من خلال جمله SET لتعريف اسماء الشيتات المستخدمه وأضفنا جملة ThisWorkbook لتحديد هذا الملف محل العمل واستخدمنا التخصيص للتعريف بإسم كل شيت من الشيتين اثناء جمله IF وكذلك فى تحديد الترحيل بين الشيتين بالأسطر الأخيرة المشار اليها بالشرح بالكود السابق بالمرفقات ملف اكسل به التطبيق العملى للمثال بالكودين وتقبلوا منى وافر الاحترام والتقدير شرح الترحيل.rar

لماذا الاخ RAGABFAROUK كل مساعداته لا تكون الا عن طريق الايميل ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟