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

شرح دالة DateAdd تعد دالة DateAdd من دوال الوقت والتاريخ المهمة حيث تستخدم في إضافة مدة معينة على تاريخ معين تتطلب دالة DateAdd تحديد ثلاثة متغيرات هي : 1- نوع الفترة التي تريد إضافتها وهل هي يوم ِأم شهر أم سنة أم ساعة أو ..... إلخ ( التي تريد إضافتها ) 2- العدد أي ما هو عدد الأيام أو الأشهر أو السنوات أو الساعات أو ..... إلخ ( التي تريد إضافتها ) 3- التاريخ الذي تريد الإضافة إليه وتستخدم الدالة بالصيغة التالية : 'Syntax : DateAdd(interval, number, date) DateAdd(التاريخ, العدد, نوع الفترة) 'Examples : x = DateAdd("yyyy", 1, Date()) x = DateAdd("m", 5, Date()) x = DateAdd("d", 14, Date()) Interval Description yyyy Year q Quarter m month y Day of the year d Day w Weekday ww Week h hour n Minute s Second

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

إذا كانت المعادلات في الصفحة الثانية معادلة بحث فالحل هو الاضافة او الحذف في الصفوف بعد الاول وقبل الاخير في جدول البحث بمعنى اذاكان البحث من الصف 3 الي الصف 100 فالحذف بعد 3 وقبل 100 لن يؤثر على معادلات البحث أما إذا كانت المعادلة مجرد نقل للقيمة مثل =sheet1!a2 ثم تم نسخ المعادلة لاسفل فالتأثير سيكون في الصف الذي تم حذفه فقط والحل إعادة نسخ المعادلة في الشيت الثاني عن طريق مقبض التعبئة ******** والحل الذي استعمله بصورة شخصية هو عدم الحذف أو الاضافة وانما استخدام النسخ واللصق فمثلا * إذا اردنا اضافة صف بعد 5 يتم نسخ الصفوف من 6 الى آخر صف ولصقها في 7 وبعدها مسح محتويات الصف 6 القديمة * وإذا اردنا حذف الصف 5 يتم نسخ الصفوف من 6 الى الاخير ولصقها في الصف 5 وبعدها مسح محتويات الصف الاخير أرجو أن يكون اتضح المطلوب بالتوفيق

عليكم السلام و رحمة الله وبركاته الجزء الخاص بتنفيذ المطلوب في الكود الحالي هو هذان السطران ar.Offset(, -2) = ar.Offset(, 1).Value ar.Value = 0 إذا لاحظت ستجد أن المتغير ar يعني خلية العلاوة الدورية والدالة offset للانتقال من هذه الخلية عددا من الصفوف أولا ثم الأعمدة ثانيا وبناء عليه يكون تم وضع قيمة العمود التالي للعلاوة ar.Offset(, 1).Value (المرتب الحالي) في العمود السابق لها بعمودين ar.Offset(, -2) (المرتب السابق) وبملاحظة ترتيب الأعمدة في مطلوبك الجديد ستجد أن المرتب المجرد قبلها ب 3 أعمدة يعني -3 في المعامل الثاني لدالة offset قيمته = نفس قيمته + قيمة العلاوة الدورية وعليه يكون الكود ar.Offset(, -3) = ar.Offset(, -3).Value + ar.Value ويمكن وضعه قبل السطرين في حالة الاحتفاظ بدورهما ويمكن حذف هذا الجزء .SpecialCells(xlConstants).Areas من هذا السطر تجنبا لحدوث أية أخطاء For Each ar In sh.Cells(3, 6).Resize(lr).SpecialCells(xlConstants).Areas بالتوفيق

Sub Test() Dim r As Range, c As Long Application.ScreenUpdating = False With ActiveSheet Set r = .Range("L4:L" & .Cells(Rows.Count, "L").End(xlUp).Row) c = .Cells(4, Columns.Count).End(xlToLeft).Column + 1 .Cells(4, c).Resize(r.Rows.Count).Value = r.Value End With Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله وبركاتة فى البداية صورة توضيحية للمقصود الحمد لله الذى بنعمته تتم الصالحات فكرة عمل البرنامج انشاء قوائم احترافة للاكسس باستخدام Ribbon واوامر XML بدون تعب او شقاء او توهان فى الكود🧐 الاعدادات المطلوبة قبل التشغيل : 1- التأكد من ان المنطقة واللغة Arabic(Egypt) ولا يشترط ان تكون مصر فقط بل اى دولة عربية ولكن الاهم اللغة العربية خطوات التشغيل : 1- قم بأنشاء مشروع جديد يحمل مثلا أسم قاعدة البيانات الذى تريد تركيب الريبون عليها ومن ثم تحديد مسارها وستفيد هذه الخطوة أ- يانك سوف تصدر الريبون عليها دون استخدام اى شئ وسوف يكون فى الاصدار التالي بعد ايام ولكن حتى هذا الحين سوف اوضح كيفية التركيب . ب- سوف تستدعلى اسماء النماذج بالقاعدة وستعرف لماذا بالخطوة رقم 4 . 2- قم باختيار قائمة التبويب من الاعلي وانشاء تبويب جديد والحقة بالمشروع المنشئ مسبقاً والتبويب هو ( المشاريع - التبوييب - .... ) كما بالصورة بالاعلي . 3- قم بالدخول على المجموعات ومن ثم انشئ المجموعات داخل التبويب كمجموعة ( أضافة مشروع جديد ) كما بالصورة بالاعلي . 4- قم بالدخول لتاب العناصر والكنترول ومن ثم انشئ العناصر الذى تريدها داخل المجموعة المنشئه بالخطوة رقم 3 وعند اختيار نوع الكنترول انه Button سوف تجد اسماء النماذج بالقاعدة المحددة مسبقاً بالخطوة رقم 1 . 5- وبعد الانتهاء توجة الى المشاريع وافتح المشروع ومن ثم تصدير ملف Txt خطوات التركيب بالبرنامج لديك 1- قم بالضعط كليك يمين على ايقونه البرنامج بسطح المكتب الخاص بك ومن ثم open file location ستجد ملفان هما (basGDIPlus.bas - RibbonFunctions.bas) استدعهما من محرر الاكواد VB 2- وبعد ذلك قم بانشاء جدول تحت مسمي USysRibbons وبداخلة ثلاث حقول وهم Field Name Field Type Field Size ID AutoNumber Long Integer RibbonName Text 255 RibbonXml Memo وبحقل RibbonName اكتب اسم الشريط وبحقل RibbonXml قم بلصق الملف المصدر من البرنامج بالخطوة رقم 5 بالاعلى . ويجب ان تغلق قاعدة البيانات وتعيد فتحها بعد نسخ الشريط حتى يتم تحميلة ويظهر فى خصائص النموذج ومن اعدادت النموذج ثم غير ذلك ثم اسم الشرط اختار اسم الشريط لتجده ظاهراً وقريباً سوف اقوم بعمل فيديو توضيحي مع الاصداء الاحدث وبالتوفيق للجميع . AccessRibbonMaker.zip

هذا الكود يقوم بملء الخلايا الخالية فى العمود المختار ، بنفس القيمة الموجودة فى اول خلية ، الي أن يصل الي خلية بها قيمة ، فيقوم باستخدام القيمة الجديدة وهو مفيد فى الحالة التالية مثلا ان العمود الاول مكتوب به البلد مرة واحدة ، و امامها عدة اسطر للموظفين ثم البلد التالية بعد عدة أسطر و هكذا و تريد فى قائمة طويلة مليء البلد امام كل موظف ، فما عليك الا التعليم علي اخلايا فى العمود المطلوب ملؤه ثم تشغل الماكرو التالي : ( راجع المثال لتكون الصورة أوضح ) :) Sub FillEmptyAsAbove() ' ' deleteemptyRow Macro ' Macro recorded 19/07/2000 by taher to delete empty rows in aselection Application.ScreenUpdating = False Dim MyRow As Long, origraw As Long ' Z As String MyRow = Selection.Rows.Count origraw = MyRow ActiveCell.Select 'MsgBox MyRow For i = 1 To MyRow - 1 'If ActiveCell.Value <> "" Then ActiveCell.Offset(1, 0).Activate If ActiveCell.Offset(i, 0).Value = "" Then 'ActiveCell.EntireRow.Delete 'MyRow = MyRow - 1 ActiveCell.Offset(i, 0).Value = ActiveCell.Offset(i - 1, 0).Value End If Application.StatusBar = "Parsing / deleting ...." & _ Format(i / origraw, "0.0%") & " Please Wait......." Next i Application.ScreenUpdating = True Application.StatusBar = False End Sub Fill_all_empty.zip

بارك الله فيك اخي Moosak و اكثر من امثالك اذا سمحت لي بالمساهمه في الحل بالمرفق استعلامين لكل حقل من الحقول يوضح القيم الغير مدخله حسب المطلوب بالتوفيق للجميع ان شاء اللهMusndWZwayid 01_Update.rar

لتحويل اي ملف وورد الي اكسل بكفاءة عالية لابد من وجود وسيط والوسيط هو web page اذن سنحول الوورد اولا الي الويب بيج ثم الي الاكسل اتبع الخطوات الاتية : 1 افتح ملف الوورد ثم (حفظ باسم) 2 اختر (web page)من بين انواع الملفات المعروضة ثم اغلق كل شي ستلاحظ ان ايقونة الملف هي نفس ايقونة الوورد ولكن فيها صورة الكرة الارضية 3 افتح ملف الويب بيج بواسطة الاكسل ثم اعمل حفظ

تفضل أخي .. ستجدها في الاستعلام Quiry 1 = المطابقة للشروط Quiry 2 = الغير مطابقة للشروط MusndWZwayid 01.accdb

وعليكم السلام تفضل اخي الكريم بالتوفيق Project 1.rar

اخي العزيز @ahmed_2040 اضف نموذج التصدير في الملف المرفق الى قاعدة بياناتك وقم بتغيير اسم الاستعلام ومن ثم تصدير الحقول المطلوبة الى اكسيل تحباتي export excel.accdb

السلام عليكم اساتذتي الاعزاء بارك الله فيك استاذ @ابا جودى تنويه فقط لاننسى السنة الكبيسة سيقوم البرنامج باضافة يوم على شهر شباط (يصبح 29 يوم) اي لو تاريخ الاصدار 29/02/2020 سيكون تاريخ النفاذ 28/02/2021 تحياتي للجميع

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

جزاك الله خيرا وبارك الله فيك

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

بارك الله فيك اخي الغالي ابا جودي و اكثر من امثالك اذا سمحت لي بالمساهمه في الحل =(DSum("goldImport";"table1";"")/2)-DSum("goldExport";"table1";"") * مع العلم بان اسماء الحقول هنا بدون فراغات * table1 هو اسم الجدول ارجو ان يكون هو المطلوب اخي امير بالتوفيق للجميع ان شاء الله

بارك الله فيك اخي أ / محمد صالح

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

اتفضل المرفق القديم بتاعك بعد الاضافة اللى حضرتك طلبتها Aziz (2).accdb

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

إذا سمحت لي طريقة تصميم الملف تخالف العرف البرمجي (لقد عددت صفحات الشيكات ويتم الكتابة فيها وتريد القراءة من صفحات الشيكات في صفحة البيانات) والصواب أن نقوم بعمل ورقتين فقط الأولى للبيانات ونكتب فيها بيانات الشيكات والثانية للبحث والطباعة نكتب فقط رقم الشيك فيتم استدعاء بياناته من شيت البيانات رجاء مراجعة هذا الملف وكتابة رقم الشيك في الخلية O1 في شيت الطباعة وبالنسبة لكود التفقيط بالمنتدى مليء بها يمكنك اختيار ما يناسبك للعلم حتى لا تتم طباعة الخلية التي يكتب فيها رقم الشيك المراد البحث عنه تم تعيين منطقة الطباعة set print area من تبويب تخطيط الصفحة page layout ويمكن تعديلها من خلال نافذة اعداد الصفحة page setup التبويب الأخير sheet بالتوفيق chk.xlsx

ما السبب الذي يجعلك تحتاج إلى كود يقوم بهذه الوظيفة طالما أن الدالة مدعومة في جميع إصدارات الاكسل؟ نحتاج إلى تحويل الدالة إلى كود vba في حالة كونها دالة جديدة في اصدار جديد ونريد استعمال مميزاتها في الإصدارات القديمة مثل دالة textjoin مثلا اللهم إلا إذا كنت تقصد طريقة استعمالها داخل vba وفي هذه الحالة يمكنك استخدام هذه الطريقة مع تغيير المرجع والشرط كما تريد Application.WorksheetFunction.CountIf(Range("D2:D9"), ">5") بالتوفيق

الاحتمالات كثيرة أحدها نظام الفاصلة في جهازك هل هو الفاصلة فقط أم الفاصلة المنقوطة؟ يفضل إرفاق ملفك أو الشيت موضع المشكلة

حسب فهمي للمطلوب يمكنك استعمال هذه المعادلة في الخلية B3 =INDIRECT("'"&B1&"'!$B$2") مع نسخ المعادلة بالسحب يمينا حتى M3 بالتوفيق

الكود يقوم بهذا الغرض ولكن على العمود 3 بينما عمود الدائرة 16 لذا يجب تغيير هذا السطر txt = Join(Array(a(i, 3), a(i, 3)), Chr(3)) إلى txt = Join(Array(a(i, 16), a(i, 16)), Chr(3)) بالتوفيق

إذا كان المطلوب مجرد فرق بين تاريخين يمكنك استعمال دالة datedif بالتوفيق

متى وجدت عملية قسمة فمن المحتمل وجود أكثر من رقمين على يمين العلامة العشرية لذلك يفضل استعمال دالة trunc مع أي عملية ضرب أو قسمة في المرتبات وهذه الدالة مهمتها اقتصاص أول رقمين بعد العلامة العشرية بدون تقريب ولا جبر مما يجعل المجاميع متساوية مع ما يظهر في الخلايا وصيغتها العامة =trunc(a1*b1,2) وتطبيقها على المعادلة المطلوبة من حضرتك =IF(BO10="مدرس",trunc(C10*25%,2),"") بالتوفيق

يمكنك استعمال هذا الكود للتصفية أولا ثم النسخ ثم الحذف Sub copy_filtered_data() If Evaluate("=COUNTIF(I:I,""جاهز"")") > 0 Then Application.ScreenUpdating = 0 Dim lr1 As Long, lr2 As Long lr1 = Sheet1.Cells(Rows.Count, 1).End(3).Row lr2 = Sheet2.Cells(Rows.Count, 1).End(3).Row + 1 Sheet1.Range("$A$1:$I$" & lr1).AutoFilter Field:=9, Criteria1:="جاهز" Sheet1.Range("a2:i" & lr1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("A" & lr2) Sheet1.Range("a2:i" & lr1).SpecialCells(xlCellTypeVisible).EntireRow.Delete Sheet1.Range("$A$1:$I$" & lr1).AutoFilter Application.ScreenUpdating = 1 MsgBox "done by mr-mas.com" Else MsgBox "لا يوجد صفوف جاهزة لترحيلها" End If End Sub وهذا ملفك بعد وضع الكود وتغيير الامتداد (لأن معظم الأوقات يكون صاحب الاستفسار لا يعرف كيفية التعامل مع أساسيات الأكواد) بالتوفيق نسخ البيانات بعد الفلتر.xlsb

تفضل <<<<<<<>>>>>>> transport (3) (1).accdb

فاضية ؟؟؟؟؟؟؟ تقصد بيضاء بدل الصفر ..... صحيح ؟

ليس لديك سجل به اصفار ولكن لديك بعض الحقول اصفار .....

* بالنسبة للتوقيع يفضل إعداده في اوتلوك وسيتم إرفاقه مع الرسالة تلقائيا * بالنسبة للمرفقات يتم نسخ رابط الملف في العمود 1St File Path أو 2nd File Path شكرا لجميع الزملاء الذين شرفوني بمرورهم على موضوعاتي المتواضعة

تفضل اخى الفاضل نموذج - .rar

بانتظار النتيجة ...

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

جرب هذا المرفق وأخبرني بالنتيجة للعلم أنا لا استعمل outlook في الإرسال لذا لا استطيع التجربة mas_outlook_mailer2.rar

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

أخي الكريم السيد شكرا لك بالنسبة لخيارات مركز الأمان trust center حددت تعطيل الماكروات مع التنبيه disable macros with notification وهذا يعني أنه عند فتح أي ملف إكسل يحتوي على أكواد vba يظهر رسالة أعلى النافذة وتحت الشريط ribbon مضمونها أنه تم تعطيل المحتوى ويوجد زر في آخر الرسالة لتمحين المحتوى enable contents بعد الضغط على هذا الزر يتم تمكين الأكواد في هذا الملف أو يمكنك اختيار الحالة الأخيرة في خيارات الماكرو وهي تمكين كل الماكروات في حالة الثقة في مصدر الملفات التي تفتحها (أنا شخصيا محد هذا الاختيار حتى يتم تجاوز هذه المرحلة في كل فتح لكل ملف يحتوي على أكواد) أتمنى أن يكون الأمر اتضح

تم بفضل الله تلبية الطلبين في موضوع جديد تجدوه هنا http://www.officena.net/ib/index.php?showtopic=32704

أخي الكريم لا يوجد مشكلة في الملف الأول altkeylist.zip فعمله هو استخراج اختصارات لوحة المفاتيح الموجودة في البرنامج و ينقصه تمكين الماكرو سواء في النافذة الرئيسية لصفحة الإكسل أو من خيارات إكسل 2007/2010 أما بالنسبة للملف الثاني فهو إضافة add-in لفك حماية ملفات الإكسل المحمية بكلمة مرور ولكن مصمم بنسخة إكسل قديمة ولذا ينبغي استعمال كود حديث قمت بوضعه هنا http://www.officena.net/ib/index.php?showtopic=29972 والسلام عليكم ورحمة الله بركاته

طلباتك أوامر أخي طارق المطلوب تجده هنا http://www.officena.net/ib/index.php?showtopic=32704

ياريت مزيد من التوضيح