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

تم تكرار مشاركة من قبل احد الاعضاء(Alawani) ولما قمت بحذف الثانية المكررة تفاجأت بأنه تم حذف الاثنتين معاً ما السبب يا ترى؟ (سؤال الى الادارين) سؤال اخر :لماذا ممنوع علينا نحن فريق الموقع التواصل مع (الاعضاء الجدد) عبر الرسائل الخاصة بينما هم يستطيعون مع العلم اني قد قمت بالرد على المشاركة ووضع الكود اللازم لها لكن للاسف لا استطبع رفع الرد لهذا سادرج الكود هنا مع الملف (مضافاً اليه الكود) مع الاعتذار لصاحب المشاركة الاخ (Alawani) Option Explicit Sub give_certificates() With Application .EnableEvents = False .ScreenUpdating = False End With Dim Target1 As Worksheet, Target2 As Worksheet Dim sh_1 As Worksheet, sh_2 As Worksheet Dim lr1%, lr2% Dim i% Set Target1 = Sheets("Prim_cert"): Set Target2 = Sheets("Sec_cert") Set sh_1 = Sheets("Primery"): Set sh_2 = Sheets("second") lr1 = sh_1.Cells(Rows.Count, 1).End(3).Row lr2 = sh_2.Cells(Rows.Count, 1).End(3).Row Select Case ActiveSheet.Name Case "Prim_cert" For i = 13 To lr1 Step 2 ActiveSheet.Range("h2") = i - 12 ActiveSheet.Range("h23") = i - 11 '--------------------------------- ' ActiveSheet.PrintOut 'للطباعة احذف الفاصلة العليا من هذا السطر '--------------------------------- Next Case "Sec_cert" For i = 13 To lr2 Step 2 ActiveSheet.Range("h2") = i - 12 ActiveSheet.Range("h20") = i - 11 '--------------------------------- ' ActiveSheet.PrintOut 'للطباعة احذف الفاصلة العليا من هذا السطر '--------------------------------- Next Case Else GoTo Exit_me End Select Exit_me: With Application .EnableEvents = True .ScreenUpdating = True End With End Sub الملف مرفق كي يقوم الكود بالطباعة يجب حذف الفاصلة العليا من السطرين 21 و 29 من هذا الكود yahoo_salim.xlsm

أحسنت استاذ علي

الملف مع الكود Posting_with msg_salim.xlsm

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

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

من الملفات القديمة التي تمت مشاركتي لها والتي تطلب غالباً كيف نحمي الخلايا غير الفارغة بواسطة باسوورد (الباسورد في الملف / الخلية H3/ يمكن حفظة و مسحه عن عيون الفضوليين) مع حرية الغاء الجماية كما تشاء protect non empty data with Pass word.xlsm

تفضل اخى الكريم هذا الكود من ابداعات استاذنا الكبير ياسر خليل أبو البراء,له منا كل الحب والإحترام وجزاه الله عنا خير الجزاء وبارك الله فيه Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo t_time If Target.Column = 2 And IsEmpty(Cells(Target.Row, 12)) Then Application.EnableEvents = False Cells(Target.Row, 12).Value = Date Cells(Target.Row, 3).Value = Time If Application.WorksheetFunction.CountIf(Range("L2:L500"), Cells(Target.Row, 12).Value) > 1 And Application.WorksheetFunction.CountIf(Range("B2:B500"), Cells(Target.Row, 2).Value) > 1 Then Cells(Target.Row, 12).Value = "" Cells(Target.Row, 3).Value = "" Target.Value = "" GoTo t_time End If t_time: Application.EnableEvents = True Application.ScreenUpdating = False End If Range("l:l").EntireColumn.AutoFit End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True If Target.Row > 2 Then If Target.Column = 5 Or Target.Column = 8 Or Target.Column = 10 Then If Cells(Target.Row, 2) = "" Or Application.WorksheetFunction.CountIf(Range("B2:B500"), Cells(Target.Row, 2).Value) > 1 Then Exit Sub Target.Value = Now() End If End If If Target.Column = 10 And Target.Row > 2 Then Target = Format(Time, "hh:mm AM/PM") End If End Sub

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

مع الأسف استاذنا لم أصل إلى نتيجة Open.rar

اتفضل اليك هذه الروابط و و او ابحث في المنتدى باسم ترحيل او استعلام الحاق او insert into ستجد كتير موضوعات على ذلك تقبل تحياتي

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

ابدعت أستاذ سليم حاصبيا وهذا هو المطلوب كل التوفيق لك وزادك الله علماً

هذا الكود Option Explicit Sub give_integer() Range("XFD3").Resize(Application.CountA(Range("D:D")), 1).Formula = _ "=ROUND(d3,0)" Range("d3").Resize(Application.CountA(Range("D:D")), 1).Value = _ Range("XFD3").Resize(Application.CountA(Range("D:D")), 1).Value Range("XFD3").Resize(Application.CountA(Range("D:D")), 1).Clear End Sub

انا لم استعمل الكود سابقا ، ولكني اعرف ان الكود سيقوم بعمل "العمل اليدوي" ، وبالتالي نصل الى نفس النقطة!! جعفر

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

بارك الله فيكم جميعا

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

السلام عليكم اهل المنتدى الكرام اقدم لحضراتكم اليوم لعبة التساؤلات والأجوبة الشهيرة والأصلية وهى لعبة من سيربح المليون -وهذا فيديو لشرح اللعبة : وهذه هى اللعبة جزاكم الله كل خير mullioneer-لعبة_من_سيربح_المليون.rar

شكرا جزيلا استاذ على لعبة شيقة الله يبارك فيك -كنت دائما ابحث عنها جزاك الله كل خير

السلام عليكم اهل المنتدى الكرام اقدم لحضراتكم اليوم برنامج مجانى وجاهز لعمل الجمعيات الخيرية وهذه صور من البرنامج بعد التسطيب : ونظرا لحجم البرنامج الكبير اذ يصل الى 30 جيجا فقد تم رفعه على موقع خارجى واليكم الموقع : http://www.mediafire.com/file/r14tesnbmkckkae/setupJmayat-برنامج+مجانى+للجمعيات+الخيرية.exe

جزاك الله كل خير وبارك الله فيك استاذ علي برنامج رائع

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

أخى الكريم بعد وضع الكود فى ملف اكسيل جديد قم بحفظ الملف بهذه الصيغة : Excel Macro-Enable Workbook(*.xlsm) بارك الله فيك وجزاك الله كل خير

بالعكس ، اكثر من مشاركة تعتبر اثراء للموضوع واذا لاحظت ، فانا لم اشير الى SetFocus في مشاركتي جعفر

استخدم دالة me.A.SetFocus A اسم الكائن الذي تريد(التركيز) التوقف علية

وعليكم السلام 1. للتنقل بين كائنات النموذج ، انظر هنا وللعلم ، الايقونه (الصورة) تعتبر كائن في الاكسس ، 2. مادام نموذج الاكسس مصدر بياناته مرتبط بجدول/استعلام ، فهو يحفظ البيانات تلقائيا ، بزر او بدون زر ، فاذا اردت ان تحفظ البيانات بزر ، فيجب ان التعامل لحفظ البيانات بالكود. جعفر

السلام عليكم ورحمة الله اخي الفاضل kaser906 تم بفضل الله التوصل للحل ولله الفضل ثم لك فقد اعطيتني 99% من الحل ولا أعتقد أن الحل يخفى عليك ولكن على كل حال قمت بإضافة السطر التالي في الحدث If [aa] > 0 And وكانت النتائج ناجحة ولله الحمد أكرر شكري لك ولا أستغني عن رأيك في الحل

وعليكم السلام نعم ، تظهر هذه الرسالة مرة واحدة فقط عند التشفير ، فما هي المشكلة؟ جعفر

أخى الكريم قم بضبط اللغة العربية فى جهازك وذلك عن طريق الذهاب الى قائمة التحكم -Control Panal ثم بعد ذلك اختار Region and Language وبعدين Adminstrative ثم Change System Locale واختار Arabic (Egypt) واتبع الصورتين

تفضل اخى الكريم جرب هذا الكود Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 16 And Target.Row > 7 Then Cancel = True Target.Value = Now() End If If Target.Column = 17 And Target.Row > 7 Then Cancel = True Target.Value = Now() End If If Target.Column = 20 And Target.Row > 7 Then If Cells(Target.Row, 5).Value = "دوام واحد" Then: Cancel = False: Exit Sub Cancel = True Target.Value = Now() End If If Target.Column = 21 And Target.Row > 7 Then If Cells(Target.Row, 5).Value = "دوام واحد" Then: Cancel = False: Exit Sub Cancel = True Target.Value = Now() End If Target = Format(Time, "hh:mm AM/PM") End Sub

اليك رابطين و و http://www.databasedev.co.uk/report_printing.html جعفر

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

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

إذا كان عدد المحافظات كبيرا فالأفضل إنشاء جدول للمحافظات كود المحافظة اسم المحافظة ثم تستخدم هذا الكود لاستخراج رقم المحافظة من الرقم القومى ووضعه فى حقل رقم المحافظة وكذا - بالمرة - استخراج يوم و شهر و سنة الميلاد و تحويلها إلى تاريخ ميلاد كامل ووضعه فى حقل تاريخ الميلاد و هذا لكل السجلات وبسرعة مذهلة Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("tblmain") rs.MoveFirst Do Until rs.EOF rs.Edit rs!Mohafza = Nz(mID(rs![CHqawmy], 8, 2)) rs!CHBDay = Nz(mID(rs![CHqawmy], 6, 2)) rs![CHBmonth] = Nz(mID(rs![CHqawmy], 4, 2)) If Nz(mID(rs![CHqawmy], 1, 1)) = 2 Then rs![CHYear] = Val(mID(rs![CHqawmy], 2, 2)) + 1900 Else rs![CHYear] = Nz(mID(rs![CHqawmy], 2, 2)) + 2000 End If rs!Tmelad = DateSerial(rs!CHYear, rs!CHBmonth, rs!CHBDay) rs.Update rs.MoveNext Loop Me.Requery DoCmd.GoToRecord , , acFirst Set db = Nothing Set rs = Nothing فالنتيجة هى وضع رقم المحافظة فى مربع تحرير و سرد يظهر الحقل الثانى و هو اسم المحافظة و ليس رقمها

لاحظ الصورة رقم 1 الخاصة بوضع الكود الأول الخاص بورقة العمل . أما الكود الثانى الذى يوضع فى موديول نقوم بالتالى : أولا أضغط على Alt F11 من لوحة المفاتيح عند فتح ملف الإكسيل ستظهر نافذة جديدة كما بالصورة رقم 2 -فأضغط من الأعلى على insert ثم أختار Module وبالتالى اقوم بوضع الكود الثانى فى الصفحة الجديدة التى ستظهر لى جزاك الله كل خير

Option Explicit 'Sub split_name(rg) ''Dim MY_Name$ 'Dim i% 'Dim k%: k = 7 ''st = rg.Value ''MY_Name = Split(st, " ") 'For i = 0 To UBound(rg) ' Cells(2, k) = rg(i) ' k = k + 1 ' Next 'End Sub 'Sub give_name() 'Dim arr 'Dim k% 'arr = Split(Range("a2"), " ") 'For i = 0 To UBound(rg) ' Cells(2, k) = rg(i) ' k = k + 1 ' Next 'End Sub Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Column = 1 And Target.Row > 1 _ And Target.Count = 1 Then Target.Offset(0, 1).Resize(, 4).ClearContents Dim i% Dim arr, k%: k = 2 arr = Split(Trim(Target), " ") For i = 0 To UBound(arr) Cells(Target.Row, k) = arr(i) k = k + 1 Next End If Application.EnableEvents = True End Sub أولا وضع هذا الكود الأول فى حدث ورقة العمل ثم بعد ذلك قم بعمل وادخال موديول جديد وضع به هذا الكود الثانى :

هذا العمل بالأكواد VBA

لم ار اي عينة من الخلية في الطلب الأول اين الخلية و ما عنوانها و محتوياتها

بعد اذن الاخ عامر ياسر صاحب المشروع قمت ببعض التعديلات على المعادلات(حيث لا حاجة للاعمدة المساعدة ولا الى Deffined names ) فقط تدرج الشهر والسنة و اكسل يقوم بتعبئة صف التاريخ (الصف 7) مع ادراج اخر يوم بالشهر اوتوكاتيكياً 30 ،31،28، أو 29 حسب اسم الشهر والسنة كما جرى تعديل بسيط بالكود بحيث لا يقوم بادراج حرف الـ غ (من خلال Double Click)الا اذا كان هناك اسم في الصف اللازم وتاريخ في العامود المناسب الترقيم تلقائي (مجرد كتابة اسم يظهر الرقم مباشرة) عامود الترقيم محمي والمعادلات ايضاً (لعدم العبث بها عن طريق الخطأ) عسى ان اكون ساهمت بالقليل في هذا المشروع تحياتي سجل غياب salim.rar

تم تحديث الملف كما تريد وزيادة حبتين (مع الشرح الوافي للتعامل مع الكود و كيفية إيقافه عن العمل) protect non empty data with Pass word.rar

جرب هذا الملف (نغس التصميم)محدث تم حماية المعادلات لعدم العبث بها عن طريق الحطأ Tarhil natija alim.rar

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