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

السلام عليكم , الاخوة الكرام كل عام وانتم بخير بمناسبة شهر رمضان وعيد الفطر المبارك اعادهم الله علينا بالخير والبركة موضوعنا اليوم بعد غياب كما بالعنوان كيف تنفذ شاشة متطورة حتى النتيجة بالمثال افتح فورم جديد ثم قم بعمل 2 Rectangle فى الجانب والاعلى , الجانب للقائمة والاعلى كشريط للعنوان , بالنسبة للون الخلفية الخاصة بهم يمكنك عمل اللون الذى تفضله , بالنسبة للون المثال هو لون قوائم Microsoft Outlook قمت بسحبه وتطبيقه هنا , السؤال كيف تسحب لون تريده ولا تعرف درجته بالضبط ؟ يمكنك تطبيق هذه الفكرة الجديدة , هناك اداة يستخدمها مطورين الويب و المصممين لسحب الألوان بدرجاتها بدقة عالية وهذه الأداة اسمها Just color picker انظر لشكلها وللصورة قم بتنزيلها من الموقع الرسمى من هنا https://annystudio.com/software/colorpicker/ وصورتها قم بفتح الاداة وقم بالاشارة على أى لون تريده ثم اضغط على Alt+x لحفظ درجة اللون بالطريقة التى تحبها HTML او RGB وفى المثال سنستخدم الطريقتين , بالنسبة للHTML يمكنك سحب اللون بالاداة واضغط على Copy Value مع التأشير على HTML كما بالصورة قم بنسخ القيمة وفى الاكسس فى الخصائص الخاصة بأى عنصر ستجد Back Color قم باضافة رمز # قبل درجة اللون من الاداة وضعها فى الاكسس وستجد ان اللون تم تطبيقه وبالتالى قمت بأخذ لونك المفضل ويمكنك محاكاة اى تصميم لاى برنامج تحبه . ننتقل للتصميم بداية التصميم من فكرتى وتطبيقى واكوادى من البداية اللى النهاية وأتمنى دعوة بظهر الغيب بصلاح الحال , فى التصميم ستجد ان عند تحديد زر من ازرار القائمة ستقوم الايقونة بالتحرك والخط يختلف و تصبح ايقونة الزر هى الايقونة الرئيسية بالأعلى , لعمل ذلك قم بفتح الفاجيوال بيزيك وضع الاكواد التالية : Sub ReFormat(Sender As CommandButton) Me.PictureBox.Picture = Sender.Picture Me.lbl.Caption = Sender.Caption Sender.PictureCaptionArrangement = acRight Sender.FontUnderline = True End Sub شرح الكود :: المطلوب معرفة اولا الزر الذى تم ضغطه ولذلك قمت بعمل الكود السابق مع التحكم فى الزر الذى تم ضغطه كمحازاة النص والايقونة وهكذا , يمكنك زيادة حجم الخط او أي تنسيق تريده. يتم استدعاء الكود بالشكل التالى من أى زر امر : ReFormat ActiveControl تمام , طيب فى هذه الحالة التنسيق سيستمر اذا ضغطت على زر آخر وستظل الايقونة والخط بالتنسيق الذى قام الكود السابق بعمله , وبالتالى محتاجين نلغى ما قام به الكود السابق عن كل الازرار الا الزر الحالى سيحتفظ بالتنسيق الجديد . عملت الكود التالى Sub Restore() Dim ctrl As Control For Each ctrl In Me.Controls If TypeName(ctrl) = "CommandButton" Then If ctrl.Name <> ActiveControl.Name Then ctrl.PictureCaptionArrangement = acLeft ctrl.FontUnderline = False End If End If Next End Sub شرح الكود :: يقوم بالمرور على كل عناصر التحكم واذا وجدها زر سيقارن اسمها مع اسم الزر الحالى فى حالة اختلافهما يقوم بارجاع التنسيق الاصلى للزر قبل تطبيق كود التنسيق عليه , وبالتالى مع كل زر امر سيتم وضع الكود التالى Restore ReFormat ActiveControl ستجد ان هناك خط يتغير لونه مع كل ضغطة زر , هنا سنستخدم طريقة الالوان الاخرى RGB قم بسحب اللون الذى تريده بالاداة وقم بوضع اللون مثل المثال التالى : Me.Line51.BorderColor = RGB(35, 204, 183) حيث ان قيمة اللون بين الاقواس الاحمر,الاخضر,الازرق RGB . باقى TabControl متعدد الصفحات قم بانشاءه ولا تنسى بعد الانتهاء منه تحديد Style = None الخطوة الاخيرة الانتقال الى صفحات هذا الTabControl عن طريق الكود وهناك طريقتين : اذا اردت تحديد الصفحة المطلوبة والوقوف عليها يمكنك استخدام : Me.MyTabs.Pages(0).SetFocus حيث ان 0 هو رقم Index او ترتيب الصفحة فى المستعرض , وستجد عند فتح النموذج ان الصفحة 0 يتم فتحها وعند الضغط ايضاً على ايقونة المنزل سينتقل اليها . اذا اردت فتح الصفحة بدون الوقوف فيها يمكنك استخدام : Me.MyTabs.Value = 0 وستجد الطريقتين فى المثال المرفق . لا تنسى ضبط خاصية Anchor لتثبيت العناصر او مدها مع تكبير او تصغير النموذج كما فى المثال . اعتذر عن الشرح قليل التفاصيل الى حد ما ولكنى معتمد على خبرتكم . مرفق مثال به كل ما تم شرحه , دمتم بخير ستجد المثال فى اول مشاركة لأن المنتدى لم يسمح لى ان تتعدى المرفقات 4.8 ميجا . المثال مرفق Modern UI Access - Amr Ashraf.accdb قمت باضافة صغيرة لم تظهر فى الصورة المتحركة لأنها سجلت مسبقاً , عند الضغط على صورة المنزل ستعود كافة الايقونات الى مكانها الطبيعى .

اتفضل اخى @محمد احمد لطفى حاجه على قدى واكمل باقى الوحده وان شاء الله اخوانا واساتذتنا يقدموا ما لديهم Function cheekDate(sDate As Date, eDate As Date, x As Integer) If sDate = #1/1/1990# And eDate = #9/6/2016# And x = 1 Then cheekDate = DateDiff("ww", #1/1/2016#, #9/6/2016#) ElseIf sDate = #9/7/2016# And eDate = #9/30/2020# And x = 2 Then cheekDate = DateDiff("m", #9/7/2016#, #9/30/2020#) ElseIf sDate >= #9/30/2020# And x = 2 Then cheekDate = DateDiff("m", #10/1/2020#, Date) End If End Function بالتوفيق ضريبة _1.mdb

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

حل متواضع بالمعادلات بحسب ما فهمت جلب البيانات على ختيار رؤوس الاعمده 001.xlsm

لكي تعم الفائدة حل للاستاذ ياسر

معادلة ترحيل يعمل مع أي اصدار test001.xlsm

أو هنا :

السلام عليكم أخي محمد .. أطلع على هذا الموضوع .. لعلك تجد فيه حاجتك :

بعد اذن اخي @احمد الفلاحجي اذا كانت تسمية الزر = نعم ... سيقوم بتشغيل استعلام التحديث ويجعل قيمة done=True وهذا استعلام التحديث في وضع التصميم واذا كانت تسمية الزر = لا ... سيقوم بتشغيل استعلام التحديث ويجعل قيمة done=False

وعليكم السلام -نعم يمكن ذلك بهذا الكود Sub Splitbook() Dim xPath As String xPath = Application.ActiveWorkbook.Path Application.ScreenUpdating = False Application.DisplayAlerts = False For Each xWs In ThisWorkbook.Sheets xWs.Copy Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx" Application.ActiveWorkbook.Close False Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub أو كان عليك من البداية استخدام خاصية البحث بالمنتدى قبل طرح مشاركتك فبها طلبك كيفية فصل الشيتات الموجودة داخل الملف إلى ملفات منفصلة الملف به اربع صفحات.xlsm

السلام عليكم ورحمة الله تعالى وبركاته الشرح الاتى لا يخص الأكسس بصفة خاصة ولكن لحماية حذف القاعدة او اى ملف داخل مجلد او المجلد الذى يحتوى قاعدة البيانات بالخطأ اولا نقوم بعمل مجلد جديد ونعطيه الاسم الذى نريد على سبيل المثال نضع مجلد جديد داخل القطاع D ونعطى المجلد اسم BackDB نقوم بتحديد المسار ونقوم بنسخه فيكون D:\Test\BackDB ولو كان اسم المجلد من مقطعين مثل Back DB سوف يكون المسار نسخ المسار الى ملف نصى ونقوم بتعديله ليكون D:\Test\Back_DB بعد ذلك نقوم بفتح موجه الاومر DOS ونقوم بكتابة او لصق الامر الاتى cacls D:\Test\BackDB /P everyone:n ولو اسم المجلد من مقطعين يكون cacls D:\Test\Back_DB /P everyone:n ثم نضغط على المقتاح Enter من لوحة المقاتيح ثم نضغط على المفتاح Y من لوحة المفاتيح كما هو موضح فى الصورة بعد ذلك نغلق موجه الاوامر DOS ونذهب الى المجلد ونقوم بالضغط عليه كليك يمين ونختار Properties تظهر لنا النافذة الاتية نحدد التبويب Security ثم نضغط بعد ذلك على Advanced كما هو موضع بالصورة ثم بعد ذلك تظهر لنا النافذة الاتية نقوم بالتحديد اولا كما هو فى الخطوة رقم 1 بالصورة ثم بعد ذلك كما هو بالخطوة رقم 2 نقوم بالضغط على Edit ثم بعد ذلك تظهر لنا النافذة الاتية نقوم بالضعط على Show Advanced Permissions ثم بعد ذلك تظهر لنا النافذة الاتية 1- فى الـ Type نختار Allow 2- فى اختيارات الـ Permissions نقوم بإزالة التأشير من على الاتى Delete Delete Subfolders and files لتصبح الاعدادت كما بالشكل الاتى ثم نضغط OK الان انسخ قاعدة البيانات داخل المجلد او اى ملفات تخاف من فقدانها جرب حذف الملفات لن يتم حذفها حاول حذف القاعدة كذلك لن يتم حذفها كذلك اقتح القاعدة واضف اليها بيانات او عدل او احذف منها اى بيانات سوف تعمل القاعدة بشكل طبيعى جدا لو اردت حذف المجلد او اى شئ بداخلة فقط استخدم الامر الاتى فى موجه اوامر الـ DOS cacls D:\Test\BackDB /P everyone:f وبعد حذف ما تريد يمكنك اعادة الخطوات ان اردت ارجاع الحماية مرة اخرى انتهى الشرح دمتم فى امان الله...

عرفانا للجميل، وردا لبعض ما استفدته من هذا المنتدى المبارك، أقدم لإخواني (ماكرو تشكيل آلي) أستفيد منه كثيرا في مجال التشكيل، وهو عبارة عن ماكرو يقوم بالتالي: 1- ينسخ الكلمة أو الكلمتين، أو أكثر حسب تحديد الباحث، ثم يبحث بها في ملف آخر مشكول. 2- إذا وجد النص الذي يبحث عنه، فإنه ينسخه ويرجع إلى الملف غير المشكول، ليقوم باستبدال كل الكلمات غير المشكولة، فيضع مكانها المشكولة. 3- إذا لم يجد ما يبحث عنه، رجع إلى الملف ونسخ النص التالي ليبحث عنه، وهكذا. 4- يقوم بتلوين الكلمات المشكولة باللون الأحمر. 5- وفي نهاية العمليات يحفظ الملف بشكل آلي. 6- والمطلوب: أن تفتح ملف آخر مشكول ليبحث فيه الماكرو، فمثلا إذا كنت تشكل كتابا في الفقه فعليك أن تفتح ملفا آخر لكتاب فقه مشكول لينقل منه. 7- يجب أن تسمي الملف الذي تنقل منه التشكيل برمز معين، وليكن مثلا (----). 8- عند تشغيل الماكرو تخرج رسالة بعدد الكلمات المطلوب تشكيلها + 1 ، يعني لو أردت تشكيل كلمتين، فاكتب (3)، وإذا أردت تشكيل (4) اكتب (5)، وهكذا 9- والرسالة الثانية عدد مرات التكرار، يعني تكرر الأمر 100 مرة، أو 200، أو 1000، وهكذا. 10- والرسالة الثالثة فيها تحديد المدة، فيمكن أن تحدد المدة بالدقيقة، فلو كتبت (1) فهذا يعني أن الماكرو يعمل لدقيقة ثم يقف، ولو كتبت (2) فسيقف بعد دقيقتين، وهكذا. وهذا هو الماكرو لمن أراد: Sub تشكيلآلي() ' ' تشكيلآلي Macro 'ماكرو يشكل كلمات ملف من ملف آخر مشكول، بشرط فتح الملفين في آن واحد، وعند تشغيل الماكرو تختار عدد الكلمات المراد تشكيلها، كما تختار عدد مرات تكرار ذلك في الملف 'تمت إضافة تحديد الوقت في هذا الماكرو، فإذا كتبت (1) في مربع الوقت فهذا يعني دقيقةواحدة، وإذا كتبت(2)فهذايعني دقيقتين، وهكذا Dim X, a, b, c, y As Integer Dim t As Date t = Now Dim startTime As Date startTime = Now Do k = (InputBox("اكتب عدد الكلمات + 1")) X = (InputBox("اكتب عدد مرات التنفيذ")) y = (InputBox("حدد مدة تشغيل الماكرو بالدقيقة")) For i = 1 To X Selection.MoveRight unit:=wdWord, count:=1, Extend:=wdExtend If DateDiff("n", startTime, Now, endTime) = y Then ' s =عدد الثواني ' n =الدقائق ' h =ساعة MsgBox "تم تشكيل الكلمات وتلوينها باللون الأحمر" & Format(Now - t, " والوقت المستغرق = h:n:s ") Exit Do Exit Sub ActiveDocument.Save End If If (Len(Selection.Text) - 2 > 0) Then If Selection.Find.Found = False Then Windows(2).Activate Selection.MoveRight unit:=wdCharacter, count:=1 End If Selection.MoveLeft unit:=wdCharacter, count:=1 Selection.MoveLeft unit:=wdWord, count:=1 Selection.MoveLeft unit:=wdCharacter, count:=1 Selection.MoveRight unit:=wdWord, count:=k, Extend:=wdExtend a = Selection.Text Windows(1).Activate Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = a .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute If Selection.Find.Found = False Then Windows(2).Activate Selection.MoveRight unit:=wdCharacter, count:=1 Else b = Selection.Text Windows(2).Activate Selection.MoveRight unit:=wdCharacter, count:=1 Selection.Find.ClearFormatting Selection.Find.Replacement.Font.Color = wdColorRed With Selection.Find .Text = a .Replacement.Text = b .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = True .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute replace:=wdReplaceAll Selection.MoveRight unit:=wdWord, count:=1 End If End If Next i Beep MsgBox "تم تشكيل الكلمات وتلوينها باللون الأحمر" & Format(Now - t, " والوقت المستغرق = h:n:s ") Exit Do Exit Sub Loop ActiveDocument.Save End Sub

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته يسرني اليوم أن أقدم لكم هذه الهدية الرمضانية المتميزة والرائعة 😊 ( الكاتب الذكي لدوال المجال في أكسس ) Dloockup, DCount, DMax, DMin, Dfirst, DLast , DSum, DAvg هذه الأسطورة هي عبارة عن أداة صممتها في أكسس ( بفضل الله وحمده ) تقوم بكتابة دوال المجال نيابة عنك بشكل آلي .. وتعطيك النتيجة بشكل مباشر 😉👌🏼 لن يخطيء أحد بعد اليوم في كتابة جملة هذه الدوال إن شاء الله 😁 كل ما عليك فعله هو استيراد هذه الأداة لبرنامجك ثم اختيار الجدول أو الاستعلام المطلوب والحقل المراد وبعدها سترى العجب العجاب 🙂 ✨ ومن مزاياها :✨ 1 - تسهل عليك كتابة أسماء الجداول والحقول ( فقط تختارها من القائمة المنسدلة ) . 2- يحل مشكلة تداخل النصوص عند استخدامها مع الجداول والحقول المكتوبة باللغة العربية . 3- تفحص لك النتيجة مباشرة للتأكد من أنك ستحصل على البيانات التي تريدها . 4 - سهلة الاستخدام فقط اتبع الخطوات الموضحة وتأكد من اختيار نوع البيانات الصحيح . 5 - يمكنك عمل دالة بأربعة 4 معايير بكل سهولة ويسر . 6 - يمكنك عمل تعديلاتك الخاصة على الدالة مباشرة وفحص النتيجة مباشرة بعد التعديل على النتيجة النهائية . 7 - إمكانية الحصول على الصيغة الخاصة بمحرر الأكواد VBA أو الصيغة المستخدمة في الاستعلامات ومنشيء التعبير . 8- إمكانية استخدام الأداة بشكل مستقل من غير الحاجة لنقلها إلى برنامجك . 9- وغيرها الكثير مما سيفتح الله عليكم اكتشافه بأنفسكم إن شاء الله 😅 طريقة الاستخدام : سهلة يسيرة بحمد الله .. فقط قم بسحب النموذج المسمى SmartDomainFunctionsBuilder_F إلى برنامجك عن طريق السحب والإفلات .. ثم قم بفتح النموذج عندك وسوف يقوم هو آليا بالتعرف على الجداول والاستعلامات الخاصة ببرنامجك بدون الحاجة إلى جهد يذكر 🙂 ( مع إمكانية استخدام الأداة بشكل مستقل من غير الحاجة لنقلها لبرنامجك ولكنك ستفقد الكثير من المميزات 😉 ) الأداة تم عمل الكثير من التجارب عليها وتم تلافي العديد من الأخطاء وإصلاحها بحمد الله وفضله... ولكن لا زلت لا أستغني عن آراءكم وملاحظاتكم من خلال استخدامكم لها 😉 الشرح بالتفصيل : 🙂 وهنا قمت بشرح الأداة بشكل مفصل نوعا ما في مقطع فيديو مدته نصف ساعة تقريبا : وأخيرا التحميل 😊 تحميل الملف الأصلي : >> حمل من هنا آخر إصدار للأداة << تحميل الملف بلمسات المهندس العزيز @د.كاف يار : د.كاف يار __Domain Functions Builder V1.0.accdb وأهم من الأداة نفسها 😉 لا تنسوني من صالح دعائكم لي ولوالدي .. ولا تحرموني من آرائكم ومقترحاتكم ونصحكم وإرشادكم 🙂 أخوكم ومحبكم موسى الكلباني 😊 ‏‏Domain Functions Builder V1.0.accdb

السلام عليكم سوف نشرح في هذا الموضوع طريقة سهلة جدا لإضافة QR CODE للتقرير داخل مربع نص و يدعم اللغة العربية كذلك أولا: هناك ملف تنفيذي يقوم بتسجيل الأدوات و نوع الخط نقوم بتثبيته داخل الكمبيوتر ثانيا: لإضافة QR CODE نقوم باستدعاء الوحدة النمطية الموجودة في المرفق في مصدر عنصر التحكم لمربع النص و نغير نوع الخط إلى BCW_2D =QrCode([T];1;1;صواب;4;1) [T]: هو مربع نص نأخذ منه البيانات و هذا رابط المصدر : https://barcodewiz.com/user-manual/qr-code-fonts/create_qr_code_barcodes_in_ms_access.aspx و أخيرا تمتع بـQR CODE رائع أرجوا من الإخوة تجربته و موافاتنا بالنتائج. توليد QR CODE.rar

شاهد المرفق اخي xl.rar

منور اخى ومهندسنا العزيز @Eng.Qassim اخى محمد فى تعديل بسيط للشرط الاخير Function cheekDate(sDate As Date, eDate As Date, x As Byte) If sDate >= #1/1/1990# And eDate <= #9/6/2016# And x = 1 Then cheekDate = DateDiff("ww", sDate, eDate) ElseIf sDate >= #9/7/2016# And eDate <= #9/30/2020# And x = 2 Then cheekDate = DateDiff("m", sDate, eDate) ElseIf sDate >= #9/30/2020# And sDate <= Date And x = 3 Then cheekDate = DateDiff("m", sDate, eDate) End If End Function

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

ربنا يبشرك بكل خير ان شاء الله اتفضل وقمت بعمل تعديل بسيط عليها ايضا Function cheekDate(sDate As Date, eDate As Date, x As Byte) If sDate >= #1/1/1990# And eDate <= #9/6/2016# And x = 1 Then cheekDate = DateDiff("ww", #1/1/2016#, #9/6/2016#) ElseIf sDate >= #9/7/2016# And eDate <= #9/30/2020# And x = 2 Then cheekDate = DateDiff("m", #9/7/2016#, #9/30/2020#) ElseIf sDate >= #9/30/2020# And x = 3 Then cheekDate = DateDiff("m", #10/1/2020#, Date) End If End Function بالتوفيق ضريبة _2.mdb

انظر للمرفق..لقد استغنيت عن جدول التصنيف Database32.accdb

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

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

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

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

السلام عليكم ورحمه الله وبركاته @محمد احمد لطفى مشاركه مع اخوتى الافاضل قمت بتجربه بسيطه ولكن النتائج مختلفه عما ذكرتها 1 = 35 2 = 50 3 = 19 فايهما اصح ساقوم بمراجعه الرابط الذى وضعته وحل استاذنا العزيز أبو ابراهيم الغامدى جزاه الله خيرا لعلى اصل للصحيح بالتوفيق

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

شكرا و الف شكر اساتذة الافاضل و جزاكم الله كل خير @احمد الفلاحجي @سامي الحداد استاذي @سامي الحداد تعديل رائع بارك الله فيك و جزاك الله كل خير

جزاكم الله خيرا @Eng.Qassim @احمد الفلاحجي تم عمل المطلوب ربي يحفظكم

السلام عليكم أخي الكريم @أبو إيمان أحسنتم بارك الله بكم،وفقكم الله لما يحب ويرضى، عمل موفق إن شاء الله تعالى. تقبل تجياتي العطرة

الملف المرفق لاحد الاعضاء يوجد به أكواد للترحيل والاستدعاء يمكننك الاستفادة منه في موضوعك كود ترحيل واستدعاء.xlsm

وعليكم السلام-تفضل تم عمل قائمة منسدلة بأرقام الجلوس وبناءاً على اختيارك منها سيتم جلب بيانات الشهادات شهادات ,والراسبين 4 تعريق 1متغيرات.xlsm

اذا كان ما تريد هو حساب العمر بين تاريخين اليك هذا النتيجه (مرفق معها مديول "داله حسابيه ") Function fAge(dteStart As Variant, dteEnd As Variant) As Variant '******************************************* 'Purpose: Accurately return the difference ' between two dates, expressed as ' years.months.days 'Coded by: raskew (from MS Access forum) 'Inputs: From debug (immediate) window ' 1) ? fAge(#12/1/1950#, #8/31/2006#) 'Calculate btw 2 specific dates ' 2) ? fAge(#12/30/2005#, Date()) ' Calculate as of today's date '******************************************* Dim intHold As Integer Dim dayhold As Integer 'correctly return number of whole months difference 'the (Day(dteEnd) < Day(dteStart)) is a Boolean statement 'that returns -1 if true, 0 if false intHold = DateDiff("m", dteStart, dteEnd) + (Day(dteEnd) < Day(dteStart)) 'correctly return number of days difference If Day(dteEnd) < Day(dteStart) Then dayhold = DateDiff("d", dteStart, DateSerial(Year(dteStart), Month(dteStart) + 1, 0)) + Day(dteEnd) Else dayhold = Day(dteEnd) - Day(dteStart) End If fAge = LTrim(Str(intHold \ 12)) & " years " & LTrim(Str(intHold Mod 12)) & " months " & LTrim(Str(dayhold)) & " days" End Function ضريبة (1).mdb

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

DateDiff("ww";[txtDate1];[txtDate2]) لكن افضل ان تكون DateDiff("d";[txtDate1];[txtDate2])/7 لا فى الدالة الاولى اذا كان الفتره بين التاريخين هم 4 اسابيع ويومين كمثل فانه يحسبه 5 اسابيع DateDiff("m";[txtDate1];[txtDate2])

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله عنا كل خير وانت طيب بالتوفيق

السلام عليكم ورحمه الله وبركاته مشاركه مع اخوانى واساتذتى الافاضل جزاهم الله عنا كل خير اخى @nabilalibibo جرب التعديل التالى Like [Forms]![frm_Search]![Ser_Grade] & "*" بالتوفيق فرز_1.accdb

السلام عليكم ورحمة الله وبركاته أخي الكريم الحل كما يلي: نضع التاريخ الأول في خلية ما ثم في الخلية التالية الرقم الذي تريد جمعه أو طرحه ثم في الخلية التالية تضع = (خلية التاريخ-1) +أو - خلية الرقم المطلوب ينتج عندك تاريخ جديد هو حاصل جمع أو طرح خلية الرقم مع أو من (خلية التاريخ الأول-1) مع مراعاة عدد الأيام في كل شهر. أما -1 لكي لا يحسب يوم البدء مرتين. والله أعلم تقبل تحياتي والسلام عليكم

وجزاكم مثله اخى الكريم الحمد لله الذي بنعمته تتم الصالحات

وعليكم السلام اخى @محمد عدنان طلبك من البدايه كان ترحيل صف واحد وهو في الخليه b4 من شيت data وهذا ما تم عمله اختر افضل اجابه لسؤالك وافتح موضوع جديد بالطلب الجديد وان شاء الله تجد مطلبك سواء منى او من الاساتذه

تفضل الحل ... عن طريق الكود !!! Copy of GCC_Expense_Report_Tax_Details_190621 1_تم التعديل.xlsb

هذه المعادلة في A2 مع (Ctrl+Shift+Enter) =IFERROR(INDEX($H$5:$Q$5,SMALL(IF(INDEX($H$6:$Q$11,MATCH(A$1,$G$6:$G$11,0),)<>0,COLUMN($H$5:$Q$5)-COLUMN($H$5)+1),ROWS(A$2:A2))),"") الملف مرفق Moustfa.xlsx

وعليكم السلام 🙂 هذا سطر حفظ الملف (انا اعطيت صورة كل نوع من الباركود اسم مختلف) ، واسم الصورة هنا QR_code.png : Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "QR_code.png" & Chr(34) اذا اردت حفظ الصورة برقم ID الموظف ، سيكون الكود: Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & Me.ID & Chr(34) بس مثل ما انا قلت في البداية ، واقعا ما تحتاج الى صورة لكل موظف ، لأنك تحتاج تطبع الهوية والسلام ، فمافي داعي لحفظ الصورة ، وخصوصا اذا عملت تغيير في البيانات ، فالصورة القديمة لن تنفعك ، بينما طباعة هوية جديدة تعطيك جميع البيانات الجديدة 🙂 جعفر

الملف المرفق فيه تعديل على المعادلة و النتيجة صحيحة ان شاء الله (Ctrl+Shift+Enter) =IF(N(O5)=0,O5,SUM(IF(ISNUMBER($O$5:$O$129)*(O5<$O$5:$O$129),1/COUNTIF($O$5:$O$129,$O$5:$O$129)))+1) الملف ترتيب4 Salim.rar

اعرض الملف الفرق بين تاريخين بالميلادي والهجري بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته كل عام أنتم بخير وسعادة ورضا ============== استكمالا لسلسلة ما خف وزنه وغلا ثمنه موعدنا اليوم مع ملف يحتاجه كل مهتم بالتواريخ في الأكسس مثل حساب العمر أو مدة بينتاريخين ------------------------------- سواء بالتقويم الميلادي أو الهجري ////////////////////////// سواء التاريخ منسق كتاريخ أو كنص ++++++++++++++++++ ولا ينقصني سوى دعاؤكم لي بالخير في الدنيا والآخرة ********************** الكود يعمل على كل إصدارات الأوفيس دمتم في رعاية الله وحفظه والقادم أفضل إن شاء الله صاحب الملف أ / محمد صالح تمت الاضافه 31 ماي, 2017 الاقسام قسم الأكسيس

أخي الكريم هذا ملف آخر يمكنك من اختيار الملف الذي تريد فتحه ... Open Excel File Using File Dialog On UserForm.rar

سلمت يداك اخي الاسيوطي عمل رائع يضاف لقائمه اعملك بس ياتري عندك فكره جديده لتجديد الفتره بعد انتهاء الفتره

وعليكم السلام ربما يفيدك هذا الرابط http://www.officena.net/ib/topic/58789-ماهو-افضل-برنامج-لإضافة-ملف-فلاش-الى-الاكسل/?do=findComment&comment=375462

اخي لا اعتقد ان ذلك ممكن اذا كنت تقصد انك عندما تعدل في ملف اكسيل ينعكس ذلك على ملف فلاشي اما ان كان لديك ملفات فلاش مسجلة سابقا فذلك ممكن

أخي الحبيب أبو يوسف جرب التعديل البسيط في الكود Sub SplitWB() 'يقوم الكود بفصل بيانات كل موظف في مصنف جديد مقسم إلى أوراق عمل جديدة '-------------------------------------------------------------------- 'تعريف المتغيرات Dim WB As Workbook Dim Arr Dim I As Long 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False Application.DisplayAlerts = False 'تعيين قيمة للمتغير ليساوي كل القيم في النطاق الحالي في ورقة العمل 'المتغير يخزن البيانات على شكل مصفوفة Arr = ThisWorkbook.Sheets("Sheet1").Cells(1).CurrentRegion.Value 'حلقة تكرارية من الصف الثاني وحتى آخر صف به بيانات 'الحد الأعلى للبعد الأول للمصفوفة ألا وهو بعد الصفوف [UBound(Arr, 1)] حيث يمثل هذا الجزء For I = 2 To UBound(Arr, 1) 'ليساوي المصنف الجديد [WB] تعيين المتغير Set WB = Workbooks.Add 'بدء التعامل مع المصنف الجديد With WB 'إضافة ورقة عمل باسم "ملاحظات" ، ووضع البيانات المرتبطة من العمود التاسع بالمصفوفة With .Sheets.Add .Name = "ملاحظات" .Range("A1") = "ملاحظات" .Range("B1") = Arr(I, 9) .Columns.AutoFit End With 'إضافة ورقة عمل باسم "الأداء والمعلومات المالية" ، ووضع البيانات المرتبطة من العمود الرابع والسابع والثامن بالمصفوفة With .Sheets.Add .Name = "الأداء والمعلومات المالية" .Range("A1").Resize(3, 1) = Application.Transpose(Array("التقييم السنوي", "الراتب", "البدلات")) .Range("B1") = Arr(I, 4) .Range("B2") = Arr(I, 7) .Range("B3") = Arr(I, 8) .Columns.AutoFit End With 'إضافة ورقة عمل باسم "المعلومات الأساسية" ، ووضع البيانات المرتبطة من العمود الأول والثاني والثالث والخامس بالمصفوفة With .Sheets.Add .Name = "المعلومات الأساسية" .Range("A1").Resize(5, 1) = Application.Transpose(Array("اسم الموظف", "تاريخ التعيين", "الجنسية", "الوحدة", "الشعبة")) .Range("B1") = Arr(I, 1) .Range("B2") = Arr(I, 2) .Range("B3") = Arr(I, 3) .Range("B4") = Arr(I, 5) .Range("B5") = Arr(I, 6) .Columns.AutoFit End With 'وهي ورقة عمل افتراضية في أي مصنف جديد [Sheet1] حذف ورقة العمل المسماة .Sheets("Sheet1").Delete 'حفظ المصنف الجديد في نفس مسار المصنف الحالي باسم البيان الموجود في العمود الأول بالمصفوفة .SaveAs ThisWorkbook.Path & "\" & Arr(I, 1) & ".xlsx" 'إغلاق المصنف الجديد الذي تم حفظه .Close End With 'الانتقال لصف جديد والتعامل مع مصنف جديد Next I Application.DisplayAlerts = True 'إعادة تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True 'رسالة تفيد بانتهاء عمل الكود MsgBox "Done !", vbInformation End Sub تم إضافة سطرين لإلغاء رسائل التنبيه وإعداة تفعيلها بعد انتهاء الكود الغريب أن الكود يعمل معي بدون رسالة الخطأ وعلى نفس النسخة 2007

Date And Time At Forms Caption لإظهار تاريخ اليوم والوقت بدل اسم النموذج ، الكود التالي يفي بالغرض مع تثبيت الرقم 1000 في Timer Interval Private Sub Form_Timer() Me.Caption = " Today is " & "Date :" & " " & Format$(Now()), "dd mm yyyy " & " Time : " & "h:mm:ss AMPM" End Sub >>>>>>>>>>>>

أخى الفاضل / هذا الملف لأحد الزملاء افتحه قد يفى بالغرض منع فتح الملف إذا تم نقله أو تغيير إسمه ومنع حفظه بإسم جديد.rar