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

@مريم2 التوقيع واضح اختي الكريمة ولا يحتاج للتاويل. للتوضيح فقط ليس كبرا مني لا اريد المساعدة ولكن لا اريد فتح المجال لعدة تعديلات يصبح الموضوع مشوش لبعض الاعضاء عند البحث عن موضوع معين مما يجعل المنشور كبير وممل كما انه يفقدني الحماسة في تقديم المساعدة . اعادة تصميم الكود او الصيغة من جديد ليس بالامر السهل خصوصا مثلي غير متخصص بالبرمجة عبارة عن هواية بالنسبة لي . ثقي تماما انت وغيرك من الاعضاء اذا احد طلب من تعديل ولم اجيبه اما لانه مضيعة للوقت او لا استطيع المساعدة لان هذا خارج امكانياتي . يمكن بقية الاعضاء يتساهلوا في عملية التعديل اما انا فلا بناء على ماسبق وعذرا على الاطالة . وهذه محاولة ان لم يكن ما تريده اعذريني وانتظري شخص اخر . هناك من اذكى مني واكثر احترافا في هذا المنتدى . تحياتي السؤال 5.xlsx

@a.kawkab هل من سبب انك لا تشير الى صاحب الجهد لهذا الكود الذي اخذته من هذا الموضوع المشابه وقمت بتعديل اسماء الشيتات https://www.officena.net/ib/topic/113326-تسمية-الملف-بإسم-الأسبوع-والسنة-تلقائيا-عند-الحفظ/ 🤔

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

The request is weird a little and using data validation list is better than using the code in worksheet module Generally here's the code (In Worksheet Module) Private Sub Worksheet_Change(ByVal Target As Range) Call Worksheet_SelectionChange(Target) End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Target If .Cells.CountLarge > 1 Then Exit Sub If .Row > 1 And .Column = 2 Then If LCase(.Value) = "yes" Or LCase(.Value) = "no" Then Application.EnableEvents = False .Value = StrConv(.Value, vbProperCase) .Font.ColorIndex = xlAutomatic Application.EnableEvents = True Exit Sub Else Application.EnableEvents = False .Value = Empty Application.EnableEvents = True End If If .Value = "" And .Offset(, -1).Value <> "" Then Application.EnableEvents = False .Value = "Type 'Yes' to accept - Type 'No' to reject" With .Font .Name = "Calibri" .FontStyle = "Regular" .Size = 9 .Color = RGB(217, 217, 217) End With Application.EnableEvents = True End If End If End With End Sub

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

أكرمك الله أخي الكريم نعم يوجد خصم لأعضاء هذا المنتدى، ومن يحتاجها ولا يملك ثمنها فأنا مستعد لتقديمها له مجاناً

@Hicham1470 هذا الموضوع تم حله قم باصدار منشور جديد لتجد تفاعل اكثر من باقي الاعضاء 😉

اخي الصادق ـ ح اذا كان فهمي صحيح فهذا طلبك تفضل البطاقة المدرسية officena.xlsm واذا كان فهمي غير صحيح فمن فضلك قم بأرفاق ملف مدعوم بشرح كافي

ما دمت نصحتك بعدم استخدام الجدول الواحد فكان لزاما ان اعرض عليك البديل تفضل المرفق يشتمل على : 1- ثلاث جداول للحسابات ( يمكن ضمها في استعلام واحد والتعامل معها) 2- لمسات على الشجرة : - ضبط الاتجاه الى اليمين بكود مختصر - تلوين العقد كما يوجد خصائص اخرى لتنسيق العرض الشجري كتلوين الخلفية وفتح النماذج من خلال النقر على العقد ، يمكن تحقيقها حسب الرغبة والطلب treeviewClr.rar

تفضل 1.accdb

اعتقد اني وجدت الحل لك وذلك عن طريق الكود للاستاذ @Eng.Qassim If Me.tot = 0 Then Dim ID As Long ID = CurrentRecord - 1 Me.tot.Value = DLookup("tot", "asas", "ID=" & ID) End If

انظر للمرفق teatea.accdb

اسف لايوجد عندي حل لكني منتظر معك الاجابة

السلام عليكم ورحمة الله وبركاته ما شاء الله بارك الله كود رائع أخي الحبيب @lionheart أسأل الله تعالى أن يزيدك من نعمه ومن علمه آمين.

السلام عليكم 🙂 هذا المنتدى للتبادل العلمي ، حتى يستفيد منه الجميع ، وليس صاحب الموضوع / السؤال فقط 🙂 فيا ريت ان نضع الاجابة بالتفصيل في الرد (سواء الخطوات او الكود او صور من شاشة البرنامج) ، ولا نتوقف عند ارفاق المرفق الذي به الرد / الجواب ، والسبب هو ، حتى يستطيع الجميع رؤية الرد ومعرفته مباشرة ، دون اللجوء الى انزال المرفق وفهمه 🙂 نعم ، هذا عبء إضافي ، ولكن نتائجه ستكون مثمرة ان شاء الله 🙂 وتذكروا ، هذا مجرد طلب ورجاء ، وليس اجباري 🙂 شكرا جزيلا 🙂 جعفر

وعليكم السلام تفضل اخى الكود .... مرفق الملف Sub export_sheets() Dim Fname As String, ws As Worksheet Application.DisplayAlerts = False Sheets(Array("2", "4", "6", "8", "10")).Copy For Each ws In ActiveWorkbook.Sheets ws.UsedRange = ws.UsedRange.Value Next ws ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "schoolclass " & NM, FileFormat:=51 ActiveWorkbook.Close Application.DisplayAlerts = True MsgBox "Done...", 64 End Sub School.xlsm

لهذا السبب لم اطلب منك تجربته ، فهذا الاستعلام الاصل الذي طُلب مني النظر في سرعته 🙂 وفي الواقع يُفتح الاستعلام ، ولكن يحتاج الى وقت طويل 😁 هناك طريقتين ، وانا اعطيتك الطريقة الاسهل ، لأنك تقدر تشوفها وتعدل فيها ، الطريقة الثانية مثل ما قال اخوي حسنين @SEMO.Pa3x باستعمال الاستعلام الفرعي ، وهو استعلام بهيئة SQL ، فليس من السهل عمله وتعديله !! اسألك سؤال: هل الافضل ان تستعمل الاستعلام dsum_eqaza كما هو (لاحظ ان البرنامج المرفق هو نسخة مصغرة من البرنامج الاصل ، والذي عدد سجلاته حوالي مليون سجل) ، وتنتظر 28 دقيقة ليفتح ، او تعمل 10 استعلامات وتجعل الاستعلام يشتغل بوقت اسرع بكثير ؟ وللعلم ، هناك مبرمجين وظيفتهم تسريع الاستعلامات 🙂 ما ادري ، لازم اشوفه !! ولكن وكما رأيت في المثال اعلاه ، فككنا كل استعلام DSum باستعلام واحد خاص به ، ثم ربطناهم باستعلام يجمعهم جميعا. انا شايف ان هناك مبرمجين لا يريدون الكود الطويل ، ولا يريدون استعلامات كثيرة ، بينما الطريقة الصحيحة في البرمجة هي ان تعمل الافضل لبرنامجك ، والبرنامج يقوم بالباقي 🙂 معلوماتي كانت قديمة في هذا المجال ، فأخذت الوقت لأقرأ مرة اخرى ، واليك الملخص: 1. اذا واجهة الاكسس والجداول على نفس الكمبيوتر ، 2. واذا عملت على SQL Server من نفس السيرفر ، سيكون الاكسس اسرع ، وبوقت ملحوظ ، طبعا نتكلم عن بضع عشرات/مئات آلاف السجلات 🙂 اما اذا: 3. الجداول على الشبكة ، وواجهة الاكسس على كمبيوتر في الشبكة ، 4. برنامج SQL Server على السيرفر ، والمستخدم على كمبيوتر في الشبكة ، فسيكون SQL Server اسرع 🙂 وبغض النظر عن مكان تواجد الواجهة والجداول ، فاذا كلامنا عن ملايين السجلات ، فهذا تخصص SQL Server ، ومع ان الاكسس يستطيع التعامل معه اذا كان الاكسس 64بت وكمية الذاكرة المؤقتة RAM على الاقل 4 جيجا (طبعا يُفضل ان يكون اكثر). هناك اعتقاد خاطئ ، بأنه اذا استعملت SQL Server بدل عن جداول الاكسس ، فسيكون البرنامج اسرع ، لأنه حتى تستطيع الحصول على افضل سرعة في SQL Server فيجب ان يكون في جداولك اعدادات معينة مثل المفتاح الاساس Primary key (وهو غير عن الفهرسة) ويحتوي على حقل تاريخ ووقت عمل السجل (بالثواني) ، وللاستعلام تستعمل Stored Procedure . جعفر

اخي Salem2020 بما انك لم تستخدم اله البحث في المنتدي تفضل طلبك هنا نموذج كنترول (1).xlsm718.6 kB · 7 downloads

اخي khairi ali مرة اخري تفضل مخزن.xlsm

اللهم بارك كيف يكمن التواصل للشراء أخي شحادة؟

فعلا، بارك الله في أخينا شحادة ابن بشير، بشَّره الله بما يسرُّه.

تفضل جرب هذا والتعليمات في الداخل عند ظهور هذه الرسالة فعل علامة الصح كما في الصورة تجربة1.xlsm

وعليكم السلام-يمكنك وضع هذا الكود فى حدث Thisworkbook بملفك ... فقط عليك بوضع اسم جهازك بالكود مكان ("Computername") بين القوسين .. وشكرا وهذا كود بسيط لمعرفة اسم جهاز الكمبيوتر لديك .عند وضع بمديول عادى Sub know() Msgbox ENVIRON("Computername") End Sub Private Sub Workbook_Open() Dim ChkName As String ChkName = MY - PC If Environ("Computername") <> ChkName Then MsgBox "File is only available to PC: " & ChkName, _ vbCritical + vbOKOnly, "Cannot Open File" Application.DisplayAlerts = False ThisWorkbook.Close Exit Sub Else MsgBox "PC security check passed.", vbOKOnly + _ vbInformation, "File Open Succesful" End If End Sub

السلام عليكم اخوي السالم .. على طريقتي ولن اتركها وهي تقديم النصيحة .. قبل ان اقول ان الجدول الوحيد للحسابات قد تعداه الزمن ، وهو مناسب فقط للعمل عليه على اكسل الحسابات في هذا الجدول تكون مصاحبة او متزامنة مع تحليل البيانات عند الشروع في تصميمه . فيؤخذ بالاعتبار انه سيتم ادخال جميع الحسابات (الرئيسية والفرعية ) يدويا ، لاعتبارات فنية عديدة .. وحتى لو لم يستخدم بعضا منها ختاما .. يكفي من عيوب الجدول الواحد انه مخالف لقواعد البيانات العلائقية

الم تقراي توقيعي قبل اضافة متطلبات جديدة ؟😱 هل من العدل بعد الاجابة تقوم باضافات جديدة ومتطلبات جديدة لم تكن موجود في سؤالك . يجدر بك اختيار اجابتي واقفال الموضوع وعدم اهدار وقت الاعضاء في كل مرة يدور في بالك فكرة تريدين تطبيقها .🙄 لماذا نقول دائما يجب وضع متطلباتك في الملف .

بصراحة هذا اخر محاولة وساخرج من هذا الموضوع تم اعطائه اكثر من حجمه Sub export_sheets() Dim Fname As String, ws As Worksheet Application.DisplayAlerts = False Sheets(Array("SH1", "SH3")).Copy For Each ws In ActiveWorkbook.Sheets ws.UsedRange = ws.UsedRange.Value Next ws ActiveWorkbook.SaveAs Filename:= _ "C:\Users\PC WORLD\Desktop\" & " report_ " & "W" & Format(Date, "WW") & "_" & Format(Date, "YYYY") & ".xlsx", FileFormat:=51 ActiveWorkbook.Close Application.DisplayAlerts = True End Sub

هذه محاولة واعتقد لديك خطا بالعد للموظف الثاني للسفر عد العناصر.xlsx

من أفضل الإضافات التي مرت علي في الوورد على الإطلاق هل يوجد خصم للسعر لأعضاء هذا المنتدى؟

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

In cell S3 you can use this formula instead of hard-coding the formula in that terrible way =IFERROR(INDEX(XEX:XEX,MATCH(R3,XEY:XEY,0)),"")

[الجديد في التحديث 6.80]: 1- من الآن فصاعداً، عند إصدار تحديث جديد للبرنامج، سيقوم البرنامج مباشرة بتحميل التحديث من رابط مباشر، ولن ينقلك لموقعي كي تقوم بتحميل التحديث منه. 2- في قائمة الشعر العربي، تم إضافة خاصية جديدة (الأبيات الشعرية المكررة)، والتي تستطيع من خلالها تمييز الأبيات الشعرية المكررة ضمن المستند، سواء كان التكرار على مستوى الشطر الأول أو الشطر الثاني أو أحد الشطرين أو كلا الشطرين. 3- في قائمة الشعر العربي، تم إضافة خاصية جديدة (الأبيات الشعرية الناقصة)، والتي تُمكِّنك من تمييز الأبيات الشعرية التي لم يتم كتابة أحد شطريها، وهذا مفيد لمن يعملون في مجال التحقيق. 4- تم مراجعة كل العمليات المرتبطة بالأقواس، وخاصة ما يتعلق بعلامتي التنصيص، وأصبح بالإمكان إجراء العمليات جميعها على علامتي التنصيص من حيث: التحديد، والتلوين، والحذف، والتغيير، والفهرسة، إلخ.. وذلك في جميع خدمات إضافة البيان البحثية. 5- في خدمة ما بين قوسين، تم إضافة خاصية جديدة (معرفة الأقواس الناقصة)، مثلاً: تمكنك هذه الخاصية من تمييز النصوص التي نسيت أن تضع بدايتها أو نهايتها علامة تنصيص، وذلك إذا كان يوجد في أحد طرفي النص علامة تنصيص ولا يوجد في الطرف الآخر، وهي خاصية مهمة جداً جداً؛ لأن مثل هذا الخطأ سيؤدي إلى خطأ في جميع العمليات على علامتي التنصيص كالفهرسة وغيرها؛ لذا ينصح باستخدام هذه الخاصية للتأكد من سلامة علامات التنصيص ضمن المستند قبل عمل فهرسة للنصوص الموجودة ضمن علامتي تنصيص، أو قبل إجراء غير ذلك من العمليات على النصوص الموجودة ضمن علامتي تنصيص، كذلك يمكنك تطبيق هذه الخاصية على الأقواس الأخرى التي يوفرها البرنامج.