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

تفضل التعديل New folder (2).zip

تفضل هذا التعديل odbExe2.zip

أهلا بك.. عدل الشفرة التي أشرت إليها لتصبح كالتالي Private Sub crn_DblClick(Cancel As Integer) Dim File_Path As String, File_Name As String, Name_Path As String File_Path = Application.CurrentProject.Path & "\CONTACT\" File_Name = Dir(File_Path & Me.crn & "*.pdf") If File_Name = "" Then MsgBox "لا توجد مستندات محفوظة" Exit Sub End If While File_Name <> "" Name_Path = File_Path & File_Name Application.FollowHyperlink Name_Path File_Name = Dir() Wend End Sub النجمة في سطر المتغير File_Name تعود بأسماء جميع الملفات التي في بدايتها ذات الرقم. راجع ملف التعليمات لمزيد من التوضح حول التابع Dir

ما شاء الله الكودين ممتازين مبدعين جزاكم الله خيرا

السلام عليكم ورحمة الله وبركاته : مثال عندما اكتب في التكست بوكس1 رقم (2 او 5 او 8 ) يعرض لي في (تكست بوكس2) كلمة " العراق" وعندما اكتب رقم (7 او 4 او 3) يظهر لي في تكست بوكس 2 كلمة " مصر" وهكذا () Private Sub TextBox1_Change If Me.TextBox1.Value = "2" Then "العراق"= TextBox2.Value Else "" = TextBox2.Value End If End Sub فورم.xlsm

احسنت استاذنا العزيز . بارك الله بجهودك

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

لكي يتم هذا يجب تحديد مكان تشغيل الملف التنفيذي مثلا في المسار D:\folder\file.exe مع تغيير اسم البارتيشن والمجلد والملف حسب احتياجاتك وفي حدث عند فتح ملف الاكسل يتأكد من وجود الملف التنفيذي في المسار المحدد فإذا كان موجودا يفتح البرنامج وإلا فيظهر رسالة يجب وضع البرنامج في المسار ..... كذا بكود مثل هذا Private Sub Workbook_Open() strpath = "D:\folder\file.exe" If Dir(strpath) = "" Then MsgBox "يجب وضع البرنامج في هذا المسار حتى يعمل" & chr(10)& strpath thisworkbook.close 1 End If End Sub وفي كود حذف الملف يتم إضافة سطر لحذف الملف التنفيذي kill "D:\folder\file.exe" بالتوفيق

يمكنك استعمال هذا الكود Private Sub TextBox1_Change() txt = Val(Me.TextBox1.Value) If txt = 2 Or txt = 5 Or txt = 8 Then Me.TextBox2.Value = "العراق" ElseIf txt = 3 Or txt = 4 Or txt = 7 Then Me.TextBox2.Value = "مصر" Else Me.TextBox2.Value = "" End If End Sub بالتوفيق

سلمت الله يعطيك العافية،، تمت أتم الله عليك الصحة والعافية،،

هذه عملية بحث بسيطة يمكن استخدام الكثير من معادلات البحث وأبسطها استعمال هذه المعادلة في الخلية E3 =VLOOKUP(D3, A1:B100,2, 0) حيث الرقم مكتوب في D3 بالتوفيق

انشاء الله يتفاعل الاخوة معنا شكرا استاذ حسام

جزاك الله خيرا استاذ محمد بالنسبة لمضاد الفيروسات فهو يتعامل مع ملف تحويل الاكسل على انه فيروس ( علما باني قمت بتحميله من موضوع تحويل الاكسل الى ملف تنفيذي بالمنتدى وبالنسبة للكود Option Explicit Private Const MSG_TITLE As String = "Deleting Current Workbook ..." Private Const MSG_TEXT As String = _ "You are about to permanently delete the current workbook located in :" Sub Kill_Myself() Dim lUserDecision As Long Dim sMsg As String On Error Resume Next sMsg = "Attention !" & vbNewLine & vbNewLine sMsg = sMsg & MSG_TEXT & vbNewLine sMsg = sMsg & "'" & ThisWorkbook.FullName & "'" & vbNewLine sMsg = sMsg & "from Disk!!" & vbNewLine & vbNewLine sMsg = sMsg & "Go ahead ?" & vbNewLine & vbNewLine Beep lUserDecision = _ MsgBox(sMsg, vbExclamation + vbYesNo, MSG_TITLE) With ThisWorkbook If lUserDecision = vbYes Then .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End If End With End Sub وهو في موضوع

جزاكم الله خيرا، ورزقكم سعادة. الدارين

تفضل هذا Microsoft Access Database جديد (3).zip

الملف ليس به أكواد سوى Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.ScreenUpdating = False End Sub وتعني عند تغير تحديد الخلايا يتم إيقاف خاصية تحديث الشاشة وهو موجود في بعض الشيتات وهذا الكود يمكن حذفه وكود آخر في موديول1 Sub save() ThisWorkbook.save End Sub وهو لحفظ هذا المصنف وتمت اضافة ماكرو يعرض رسالة وحذف حدث عند تغيير التحديد في جميع الشيتات يفضل تجربة هذا المرفق وملاحظة هل المشكلة مازالت مستمرة أم لا بالتوفيق مخازن شتوي 2022.rar

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

الدالة صحيحة بلا أي مشاكل وظيفتها جمع الأرقام من مدى به نصوص وأرقام بينهما مسافة ربما يكون الخطأ في وضع أول سطر من الدالة بجوار التعريف بها حيث أن الترتيب الصحيح هكذا Function SumNumOnly(rngS As Range, Optional strDelim As String = " ") As Double Dim xNums As Variant, lngNum As Long xNums = Split(rngS, strDelim) For lngNum = LBound(xNums) To UBound(xNums) SumNumOnly = SumNumOnly + Val(xNums(lngNum)) Next lngNum End Function بالتوفيق

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

أ/محمد اشكرك الله يعطيك العافية وفقك الله استاذي الفاضل

تفضل هنا حلين بعد تغيير اتجاه الخلايا وتغيير مكان البداية في شيت H-5 واحد بدالة offset وواحد بالتركيبة المطلوبة بالتوفيق how-can-get-data-from-other-sheets_2.xlsx

جميعا بإذن الله

لا يوجد مشكلة في إثراء الموضوع ولكن حتى يتم جلب بيانات عمود النسبة تحتاج إلى إضافة سطر وتعديل آخر sh.Cells(m, 8).Value = ws.Cells(r, 12).Value sh.Cells(m, 9).Value = ws.Cells(r, 13).Value For Each x In Array(2, 3, 8, 9) ليصبح الكود كاملا Sub Test() Dim x, ws As Worksheet, sh As Worksheet, r As Long, m As Long, c As Long, n As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("Sheet1") Set sh = ThisWorkbook.Worksheets("2") With sh.Range("B2").CurrentRegion.Offset(1) .Cells.UnMerge: .ClearContents End With m = 3 For r = 4 To ws.Cells(Rows.Count, "B").End(xlUp).Row sh.Cells(m, 2).Resize(, 2).Value = ws.Cells(r, 2).Resize(, 2).Value n = 4 For c = 4 To 10 Step 2 sh.Cells(m, n).Value = ws.Cells(r, c).Value sh.Cells(m + 1, n).Value = ws.Cells(r, c + 1).Value n = n + 1 Next c sh.Cells(m, 8).Value = ws.Cells(r, 12).Value sh.Cells(m, 9).Value = ws.Cells(r, 13).Value For Each x In Array(2, 3, 8, 9) sh.Cells(m, x).Resize(2).Merge Next x m = m + 2 Next r Application.ScreenUpdating = True End Sub بالتوفيق

تفضل التعديل ترتيب رقم 3 - نقل طالب واحد - نقل جميع الطلاب في المجموعة رقم 2 listboxSearch (4).zip

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

الف شكر على الرد لاكن للاسف الكود لم ينجح يا غالي

هذا الملف السابق في المشاركة السابقة بعد اضافة التواريخ الجديدة ..... انظر المرفق ..... Microsoft Access Database جديد (1).accdb

شكرا لمروركم الكريم أستاذ @خالد القدس نفعنا الله جميعا بما علمنا وعلمنا ما ينفعنا

تفضل هذا التعديل Microsoft Access Database جديد (3).zip

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

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

Hello Make sure the direction of language is Arabic before copying the codes and also make sure you have installed Arabic from Windows Settings

Sub Test() Const rAddress As String = "A2:J10" Dim ws As Worksheet, sh As Worksheet, r As Range, m As Long Application.ScreenUpdating = False Set sh = ThisWorkbook.Worksheets("ROW") sh.Cells(1).CurrentRegion.Offset(1).ClearContents For Each ws In ThisWorkbook.Worksheets If ws.Name <> sh.Name Then m = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 Set r = ws.Range(rAddress) sh.Range("A" & m).Resize(r.Rows.Count, r.Columns.Count).Value = r.Value End If Next ws Application.ScreenUpdating = True End Sub

ارفع ملف علشان نستطيع ان ننفذ عليه طلبك

تفضل اخي الكريم لكن نصيحتي لك بأن تجعل المسميات باللغة الانجليزية حتى تستطيع التعامل بسهولة مع الجداول برمجيا d.zip

Remove extra spaces in the months in column A then use this formula =NETWORKDAYS.INTL(1&D4,EOMONTH(1&D4,0),"1111011")

* لا لن تضاف تلقائيا ؛ لأنك حددت مصدر بيانات الجدول المحوري من A1:H6 وحتى تضاف تلقائيا يجب تنسيق المدى الموجود في ورقة1 كجدول format as table من تبويب الصفحة الرئيسية home ثم تعديل مصدر بيانات الجداول المحورية change data source إلى نفس المدى في ورقة1 ولكن هذه المرة سيظهر المدى باسم جدول1 أو table1 * لتعديل عناوين في الجداول المحورية مثل rows labels & columns labels & grand total يتم تحديد الخلية ثم كتابة التسمية المطلوبة ثم ضغط مفتاح الادخال Enter بالتوفيق

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

تفضل هذا ملفك بعد تعديل إجراء التسليم إلى ما يلي Sub Submit_Data() Dim iRow As Long, row As Long, sh As Worksheet If frmDataEntry.txtRowNumber.Value = "" Then Set sh = shDatabase iRow = sh.Range("A" & Rows.Count).End(xlUp).row + 1 Else If frmDataEntry.ComboBox7 = "Check OUT" Then Set sh = Sheet2 iRow = sh.Range("A" & Rows.Count).End(xlUp).row + 1 row = frmDataEntry.lstDatabase.List(frmDataEntry.lstDatabase.ListIndex, 0) + 1 ThisWorkbook.Sheets("Database").Rows(row).Delete Else Set sh = shDatabase iRow = frmDataEntry.txtRowNumber.Value End If End If With sh.Range("A" & iRow) .Offset(0, 0).Value = "=if(b" & iRow & "="""","""",Row()-1)" .Offset(0, 1).Value = frmDataEntry.TextBox1.Value .Offset(0, 2).Value = frmDataEntry.TextBox2.Value .Offset(0, 3).Value = frmDataEntry.TextBox3.Value .Offset(0, 4).Value = frmDataEntry.ComboBox1.Value .Offset(0, 5).Value = frmDataEntry.ComboBox2.Value .Offset(0, 6).Value = frmDataEntry.TextBox4.Value .Offset(0, 7).Value = frmDataEntry.TextBox5.Value .Offset(0, 8).Value = frmDataEntry.TextBox6.Value .Offset(0, 9).Value = frmDataEntry.TextBox7.Value .Offset(0, 10).Value = frmDataEntry.TextBox8.Value .Offset(0, 11).Value = frmDataEntry.ComboBox3.Value .Offset(0, 12).Value = frmDataEntry.ComboBox4.Value .Offset(0, 13).Value = frmDataEntry.ComboBox5.Value .Offset(0, 14).Value = frmDataEntry.ComboBox6.Value .Offset(0, 15).Value = frmDataEntry.TextBox9.Value .Offset(0, 16).Value = frmDataEntry.ComboBox7.Value End With If frmDataEntry.txtRowNumber.Value = "" Then MsgBox "Data Submitted Successfully!" Else MsgBox "Data updated Successfully!" End If Call Reset_Form Application.ScreenUpdating = True End Sub بالتوفيق program.xlsm

بعد إذن أخي الكريم @عبدالفتاح في بي اكسيل كانت لي محاولة في هذا الشأن منذ عام 2011 في الأكسس فقمت بتطويع الكود للعمل مع نماذج الاكسل فقط يتم تحديد أفضل عرض bestw وأفضل ارتفاع besth في الكود في حدث UserForm_Initialize وهما دقة الشاشة التي تم التصميم عليها بالتوفيق resizeform.xlsb

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

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

شكرا freemasn

أستاذ / رضا مهران تفضل تعديلات على البرنامج ضع أسماء الوظائف بالترتيب في العمود Z واكتب اسم وظيفة كل موظف في العمود O شئون عاملين 2019.rar

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

كلمة المرور : 12345

هل البرنامج لم ينل رضا الإخوة؟ أم المجال نفسه لا يوجد اهتمام به؟ رغم وجود معادلات وشغل عالي جدا فيه على العموم أرحب بآرائكم واقتراحاتكم أخوكم محمد صالح

رائع أخي أحمد جزاك الله كل خير

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

مشكور أخي أحمد يعقوب وإذا سمحت لي فهذه هديتي لك وللإخوة ‏طريقة إنشاء شريط أدوات جديد في اكسل و ارفاقة مع ملف محدد o من القائمة عرض تختار اشرطة الأدوات ثم تخصيص o سوف تظهر معاك الصفحة التالية o تضغط على جديد سوف يظهر لك مربع حوار التالي o تدخل هنا الإسم الذي تريده لشريط الأدوات الجديد ثم موافق o سوف يظهر لديك شريط ادوات جديد خالي من أذارير o تنتقل الى تبويب الأوامر o ثم تختار بواسطة الماوس أي امر تريدة وتسحبة و تفلته داخل شريط الأدوات الجديد o من هنا بعد عملية السحب o يمكنك الآن تغيير شكل الزر o تغيير اسم الزر o وعدة خيارات اخرى باستخدام كليك يمين على الزر الذي تريد o = = = = = = = = = = = = = = = o ((اضافة شريط الأدوات الى ملف معين)) o بعد الإنتهاء من عمل الشريط الجديد o تعود الآن الى تبويب أشرطة الأدوات مرة اخرى o و بالضغط على زر ارفاق000 o تظهر لك الشاشة التالية o داخل هذه الشاشة يوجد لديك كل أشرطة الأدوات التي تم إضافتها من قبل المستخدمين إلى اكسل o تحدد شريط الأدوات الذي تريده – ثم تضغط على نسخ o الآن بعد الضغط على موافق o أصبح شريط الأدوات المحدد مقترن تماما مع ملف اكسل المفتوح و النشط حاليا أحفظ الملف و اغلقة عند تشغيل هذا الملف في أي جهاز كمبيوتر آخر سوف يظهر تلقائيا شريط الأدوات المختار مع تحياتي و تقديري