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

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله الموضوع ليس بجديد ولكن عند إطلاعي على الموضوع القديم ووجدت بعض القصور في أكواد المحافظات وإضافة التحقق من صحة المدخلات ..فقمت بالتعديل على الدالة المعرفة ، والأصل في الدالة أنها للعلامة الكبير عبد الله باقشير ولكن تم التعديل عليها لتتلافى الأخطاء التي كانت في الإصدار السابق إليكم الدالة المعرفة .... والدالة المعرفة User Defined Function توضع في موديول ويمكن بعدها استخدامها كدوال الإكسيل العادية Function Kh_Date_Gender_Province(MyNumber As Variant, MyTest As Byte) Dim MyProvinces As Variant Dim R As Long Dim YY As String Dim TY As String * 1 Dim D As String * 2, M As String * 2, Y As String * 2, X As String * 2, XX As String * 2 MyProvinces = Array("01/القاهرة", "02/الإسكندرية", "12/الدقهلية", "13/الشرقية", "14/القليوبية", "15/كفر الشيخ", "16/الغربية", "17/المنوفية", "18/البحيرة", "19/الإسماعيلية", "21/الجيزة", "22/بني سويف", "24/المنيا", "25/أسيوط", "26/سوهاج", "27/قنا", "28/أسوان", "29/الأقصر", "33/مطروح", "23/الفيوم", "88/خارج الجمهورية", "11/دمياط", "04/السويس", "03/بورسعيد", "34/شمال سيناء", "35/جنوب سيناء", "32/الوادي الجديد", "31/البحر الأحمر") D = Mid(MyNumber, 6, 2) M = Mid(MyNumber, 4, 2) Y = Mid(MyNumber, 2, 2) TY = Left(MyNumber, 1) Select Case TY Case "2": YY = "19" & Y Case "3": YY = "20" & Y Case Else End Select Kh_Date_Gender_Province = "" On Error GoTo 1 If Not IsNumeric(MyNumber) Or Len(MyNumber) <> 14 Or Len(Trim(MyNumber)) = 0 _ Or Val(M) < 1 Or Val(M) > 12 Or (Val(TY) <> 2 And Val(TY) <> 3) Or Month(DateSerial(YY, M, D)) <> Val(M) Then Kh_Date_Gender_Province = "" GoTo 1 End If If MyTest = 1 Then If YY <> "" Then Kh_Date_Gender_Province = DateSerial(YY, M, D) ElseIf MyTest = 2 Then If Left(Right(MyNumber, 2), 1) Mod 2 = 1 Then YY = "ذكر" Else YY = "أنثى" Kh_Date_Gender_Province = YY ElseIf MyTest = 3 Then X = Mid(MyNumber, 8, 2) For R = LBound(MyProvinces) To UBound(MyProvinces) XX = MyProvinces(R) If X = XX Then Kh_Date_Gender_Province = Right(MyProvinces(R), Len(MyProvinces(R)) - 3) Exit For End If Next End If 1: End Function أرجو أن ينال الموضوع إعجابكم إن شاء الله تقبلوا تحياتي حمل الملف من هنا

نسخة Visual Studio 2012 Ultimate ISO vb.net 2012 الحجم 1.5 جيجا دي اللي هنعتمدها اي حد نزل نسخة تانية مفيش مشكلة الا اذا وجد خلاف او بعض الامور الغير متشابهه تقبلو تحياتي لو طلبت سيريال SERIAL KEY: RBCXF-CVBGR-382MK-DFHJ4-C69G8 مشكورين احبابي الغاليين بارك الله فيكم وجعله في ميزان حسناتكم وجزاكم الله خيرا

شكرا لك أخي أبوالبراء على مد يد العون لإخوانك حتى يصلوا للقمة شكرا على الإضافة الجميلة في الكود وأنت اسمح لي بتطوير هذا الكود لجعله ديناميكيا كما يأتي Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim LR As Long, N As Integer N = Sheets.Count If Sh.Index < N Then LR = Sheets(N).Cells(Rows.Count, "A").End(xlUp).Row + 1 If Target.Column < 10 And Not IsEmpty(Target) Then With Sheets(N) .Cells(LR, 1) = ActiveSheet.Name .Cells(LR, 2) = Target.AddressLocal .Cells(LR, 3) = Target.Value .Cells(LR, 4) = [vv1].Value .Cells(LR, 5) = Application.UserName .Cells(LR, 6) = Format(Date, "dd-mm-yyyy") .Cells(LR, 7) = Format(Now, "h:mm:ss") End With End If End If End Sub التعديلات هي : يجب أن تكون ورقة التغييرات آخر ورقة في الملف وأي ورقة سيتم التغيير عليها (غير ورقة التغييرات) سيتم تسجيل بياناتها N = Sheets.Count If Sh.Index < N Then إضافة اسم المستخدم الذي قام بالتغيير .Cells(LR, 5) = Application.UserName التعديلات تجدها في المرفق تعقب التغييرات1.rar

بسم الله ما شاء الله عليك أبو عيد أعمالك رائعة وتدرس ... اسمح لي بإضافة بسيطة جداً إذا كان الأمر لا يزعجك .. بدلاً من وضع نفس الكود في كل ورقة عمل تريد تعقب التغيرات فيها يمكنك وضع الكود مرة واحدة فقط في حدث المصنف .. وتضيف سطر للشرط للتعامل مع أوراق محددة .. وبهذا يكتسب الكود مرونة كبيرة ليصبح الكود بهذا الشكل في نهاية الأمر Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim LR As Long If Sh.Name = "يناير" Or Sh.Name = "فبراير" Then LR = Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row + 1 If Target.Column < 10 And Not IsEmpty(Target) Then With Sheets(3) .Cells(LR, 1) = ActiveSheet.Name .Cells(LR, 2) = Target.AddressLocal .Cells(LR, 3) = Target.Value .Cells(LR, 4) = [vv1].Value .Cells(LR, 5) = Format(Date, "dd-mm-yyyy") .Cells(LR, 6) = Format(Now, "h:mm:ss") End With End If End If End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Sh.Name = "يناير" Or Sh.Name = "فبراير" Then [vv1] = ActiveCell.Value End If End Sub والملف التالي فيه تطبيق الكود ... تقبل وافر تقديري واحترامي حمل الملف من هنا

السلام عليكم أحبابي الكرام فكرة هذا الملف هو نفس خاصبة تعقب التغييرات التي بالاكسل عند فتح المرفق تجد ثلاث أوراق الورقة الاولى : يناير الورقة الثانية : فبراير الورقة الثالثة : التغييرات غير أي خلية في الجدولين الموجودين في الورقة الأولى والثانية ستجد في ورقة التغييرات البيانات الآتية : اسم الورقة ـ عنوان الخلية ـ القيمة الجديدة ـ القيمة السابقة ـ التاريخ ـ الساعة أرجو أن ينال أعجابكم تعقب التغييرات.rar

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

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

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

تم حل المشكلة تفضل تعقب التغييرات والحذف1.rar

اذا تريد تربط النموذج الرئيسي بالنموذج الفرعي ، بحقل واحد: Link Master Fields: اسم حقل النموذج الرئيسي Link Child Fields: اسم حقل النموذج الفرعي اذا تريد تربط النموذج الرئيسي بالنموذج الفرعي ، بحقلين او أكثر: Link Master Fields: اسم الحقل1 من النموذج الرئيسي ؛ اسم الحقل2 من النموذج الرئيسي ؛ اسم الحقل3 من النموذج الرئيسي Link Child Fields: اسم الحقل1 من النموذج الفرعي ؛ اسم الحقل2 من النموذج الفرعي ؛ اسم الحقل3 من النموذج الفرعي والتسلسل هو سر الرابط ، يعني الحقل1 للنموذج الفرعي يقابله في التسلسل الحقل1 للنموذج الفرعي ، وهكذا .. جعفر

تفضل تعقب التغييرات والحذف.rar

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

السلام عليكم ورحمة الله وبركاته عمل ومجهود كبير ..جزاكم الله خيراً أخي الحبيب أبو البراء قمتم بتحليل الرقم القومي إلى مكوناته بشكل دقيق ...هل يمكن تطبيقه على شتى الأمصار العربية أم على مصر واحدة. والفكرة الأدهى كيف أمكنهم تكوين "تركيب مكوناته من تاريخ ميلاد وجنس مولود ومحافظة".. والسلام عليكم ورحمة الله وبركاته.

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

حبيبى يا ابوالبراء المشكله مش فى السريل طيب اصبر انا برفع النسخه اللى بستعملها عما تنزل ويندوز تقبلوا تحياتى

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

جرب هذا السيريال أخي الحبيب عبد العزيز 2KQT8-HV27P-GTTV9-2WBVV-M7X96

أول مشاركة أهلاً بك في المنتدى .. وكلمة واحدة لا تكفي .. اتعلم الرغي طالما عضو في المنتدى .. تقبل تحياتي

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

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

كيف أدخل لل help أخي أحمد

شكرااااااااااااااااااااااااااااااااااااااااااااااااااااااااااا

و كيف أضبطها أخي أحمد .. لم أجد منين أدخل لها .. مثلما أشرت بالصورة أعلاه

اخى عبد العزيز اعمل ريفرش للصفحه وقم بالتحميل وان شاء الله يتم التحميل معك

السّلام عليكم و رحمة الله و بركاته أخي الغالي " ياسر العربي " حملت نسخة 2015 .. فكان حجمها كبير جدًّا .. حمّلت نسخة 2013 .. و حذفتها حين إتّفقنا على نسخة 2012 حمّلت نسخة 2012 .. وبعد تسطيبها فإذا بهذه الرّسالة تخبرني بما لا يسرّ النّاظرين .. و الله لحد الآن لم تضبط معي و لا نسخة

استخدم برنامج الضغط winrar او winzip

وعليكم السلام رجاء ترفق التقرير ، وبالتالي نعرف تفاصيله لأن اللي انت تقوله شئ غير طبيعي في التقارير!! بس الصورة الثانية طبيعية ، شو الغلط فيها؟ جعفر

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

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

حسنا ولكن هل يمكن أن تمهلني إلى الغد لاني بصراحة تعبت وانا على الكمبيوتر من الساعة السابعة صباحا

اذا :- المطلوب هو عمل دالة تستند في عملها الي جدول نسب تقوم انت بادخاله يدويا وتستطيع تغير نطاق القيم واضافة نطاقات جديده؟

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

شكرا جزيلا يا أستاذ سعيد

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

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

للأسف سيكون هناك تضارب في النسخ التي سيتم تنزيلها ..أرى عبد العزيز 2013 وإمبارح أحمد منزل عدد 2 من الروابط واحد 2012 وواحد 2015 إخواني الرجاء من الأخ ياسر العربي الاستقرار على نسخة واحدة وبلغة واحدة وتفضل الإنجليزية ليكون العمل موحد ..يمكن بعدما نصل لمرحلة التمكن أن نجرب نسخ أخرى ولكن في مرحلة التعلم الرجاء الاستقرار على نسخة واحدة فقط

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

السلام عليكم ورحمة الله بارك الله فيك وجعله الله فى ميزان حسناتك

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

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

السلام عليكم ورحمة الله وبركاته إخواني الأحباب في المنتدى الأغر .. أقدم لكم كود في منتهى الروعة ، يقوم بعمل خريطة (ليست الخريطة التي في مخيلتكم .. أنا معلم لغة إنجليزية ولست معلم دراسات اجتماعية) الكود يعتمد على إنشاء ورقة عمل جديدة .. لبدء العمل فيها بناءً على ورقة العمل النشطة التي يتم تنفيذ الكود بها .. ورقة العمل الجديدة تحتوي على خلايا ملونة وداخلها رموز .. للتعرف على القيم الرقمية والنصوص والمعادلات الموجودة داخل ورقة العمل النشطة .. 'وتلوينها باللون الأصفر[N]يتم ترميز الخلايا التي تحتوي على قيم رقمية بالرمز ' وتلوينها باللون الأخضر[T]يتم ترميز الخلايا التي تحتوي على قيم نصية بالرمز 'وتلوينها باللون الأحمر[F]بالرمز[Formulas]يتم ترميز الخلايا التي تحتوي على معادلات ويوضع الكود داخل موديول بهذا الشكل Sub QuickMap() If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub 'Create object variables for cell subsets إنشاء متغيرات للكائنات التي تمثل مجموعات الخلايا On Error Resume Next Set FormulaCells = Range("A1").SpecialCells _ (xlFormulas, xlNumbers + xlTextValues + xlLogical) Set TextCells = Range("A1").SpecialCells(xlConstants, xlTextValues) Set NumberCells = Range("A1").SpecialCells(xlConstants, xlNumbers) On Error GoTo 0 'Add a new sheet and format it إنشاء ورقة عمل جديدة وعمل تنسيق لها Sheets.Add With Cells .ColumnWidth = 2 .Font.Size = 8 .HorizontalAlignment = xlCenter End With Application.ScreenUpdating = False 'Do the formula cells التعامل مع الخلايا التي تحتوي على معادلات If Not IsEmpty(FormulaCells) Then For Each Area In FormulaCells.Areas With ActiveSheet.Range(Area.Address) .Value = "F" .Interior.ColorIndex = 3 End With Next Area End If 'Do the text cells التعامل مع الخلايا التي تحتوي على نصوص If Not IsEmpty(TextCells) Then For Each Area In TextCells.Areas With ActiveSheet.Range(Area.Address) .Value = "T" .Interior.ColorIndex = 4 End With Next Area End If 'Do the numeric cells التعامل مع الخلايا التي تحتوي على قيم رقمية If Not IsEmpty(NumberCells) Then For Each Area In NumberCells.Areas With ActiveSheet.Range(Area.Address) .Value = "N" .Interior.ColorIndex = 6 End With Next Area End If End Sub فائدة الكود تكمن في إمكانية التعرف على الأخطاء التي يمكن أن تتواجد في ورقة العمل .. . لنفترض أن لديك عمود به معادلات ، وعن طريق الخطأ تم إدخال قيم ثابتة في هذا العمود .. باستخدامك لهذا الكود سيكون بإمكانك وضع يدك على الخلايا التي بها قيم ثابتة في العمود الذي يحتوي على معادلات .. أتمنى أن ينال الملف المرفق رضاكم ، وأن تستفيدوا منه إن شاء الله عزوجل تقبلوا تحياتي القلبية ، ودمتم على طاعة الله Quick Map VBA.rar

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

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

بارك الله فيك اخي الكريم.. مشاركة رائعة استفدت انا منها...

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

السلام عليكم ورحمة الله أخي الكريم، وضعت حلين في الملف المرفق مع تصحيح معادلات حساب الرصيد في الجدول.... أخوك بن علية myBook.rar

أخي الحبيب / أبو البراء إلى جانب الحلول الجميلة والمختلفة التي قدمها إخواني الأعزء ، هذا حل آخر لعله يضيف جديد للموضوع . تقبل تحياتي أبو عبدالله قائمة بالمكرر وعدد مرات التكرار وعناوين المكرر.rar

السلام عليكم ورحمة الله أخي الكريم، أعرف أن إخواننا وأحبابنا لا يبخلون بأجود ما عندهم ولا يتأخرون في ذلك... أتقدم بهذا العمل الذي هو تكملة لعمل أخي الكريم الخالدي وفيه أضفت أعمدة ذكرت فيها عناوين التكرارات (وقد جعلتها 6 تكرارات كحد أقصى، ولمن أراد أو وجد أكثر من ذلك فليقم بسحب صيغة العمود الأخير -التكرار 6- إلى عمود مجاور أو أعمدة مجاورة) (دون أن ننسى ترقيم التكرارات)... أخوكم بن علية الاسماء المكررة.rar

هذا حل يا ابو البراء تفضل المرفق Test.rar