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

أخي أحمد .. تجنب تسمية حقول الجدول بأرقام فقط .. أو أسماء تبدأ بأرقام .. تسبب لك مشاكل 🙂 أنا أضفت "c" قبل رقم كل حقل وعدلت الكود قليلا .. وشغال زي العسل .. Me.الراتب = DLookup("c" & Me.a2, "Degree", "GradeNO=" & Me.a1) وأعتقد كان شغل الأستاذ أبو أحمد مضبوط بعد 🙂👌🏼

سامحني ، هذه آخر مشاركة لي في موضوعك. موفقين. جدول الرواتب_05.accdb

اضافة لما تفضل به اساتذتي طبعا النموذج الفرعي هو للمقارنة ..والا هو (حديدة عن الطنطل) SS.rar

شكرا لك عمي جعفر ، كنت أعاني من هذي المشكلة وما عارف كيف أحلها .. 😅 والحين بعد ما عرفت .. عملت هذي الدالة لاستبدال فواصل الفقرات بالرمز "%0a" واللي تقوم بعمل السطر الفاصل بين الفقرات كما يريده الواتسأب : ' =================================(وهذه دالة لجعل الواتسأب يقبل السطور الجديدة في النص المرسل) Function ReplaceLineBreaks(text As String) As String ReplaceLineBreaks = Replace(text, vbCrLf, " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(10), " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(13), " %0a ") End Function وتستخدم كالتالي قبل ما تدخل في كود الإرسال : Dim MSG as String MSG = ReplaceLineBreaks(Me.MsgText) جربتها في برنامج مرسال الواتسأب ونجحت ولله الحمد 😊

وعليكم السلام 🙂 في الواتساب ، للإنتقال للسطر التالي ، لا تستعمل vbcrlf او chr(10) او chr(13) ، وانما استعمل "%0a" وكذلك تم ترجمة هذه الجزئية من موقع الواتساب: https://faq.whatsapp.com/539178204879377/?locale=en_US يتيح لك WhatsApp تنسيق النص داخل رسائلك. يرجى ملاحظة أنه لا يوجد خيار لتعطيل هذه الميزة. مائل لجعل رسالتك مائلة ، ضع شرطة سفلية على جانبي النص: _نص_ بالخط العريض لجعل رسالتك غامقة ، ضع علامة النجمة على جانبي النص: *نص* يتوسطه خط لتخطي رسالتك ، ضع علامة تلدة على جانبي النص: ~ نص ~ مونوسبيس لفرد رسالتك ، ضع ثلاث علامات خلفية على جانبي النص: ```نص``` ملحوظة: بدلاً من ذلك ، يمكنك استخدام الاختصارات على Android و iPhone. Android: اضغط مع الاستمرار على النص الذي تدخله في حقل النص ، ثم اختر غامق أو مائل أو المزيد. انقر على "المزيد" لاختيار خط يتوسطه خط أو مسافة أحادية. iPhone: اضغط على النص الذي تدخله في حقل النص> تحديد أو تحديد الكل> B_I_U. ثم اختر Bold أو Italic أو Strikethrough أو Monospace. جعفر

السلام عليكم الكود السابق تركته للصفحات الحالية (صفحة واحدة)، أما كود طباعة الكل فقد تم إنشاؤه من الكود السابق ثم التعديل عليه لطباعة جميع البطاقات مع إخفاء الصفوف الصفرية في كل بطاقة... أرجو أن يفي الغرض المطلوب. ملاحظة : تم إضافة معادلة في الخلية A2 لتحديد العدد الإجمالي للبطاقات. لم يتم تجربة الكود لأن الملف مرتبط ببيانات غير موجودة فيه. الكارتة.xlsm

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

أتوقع بسبب التعديلات المستمرة من أكثر من شخص .. الكود فيه تكرارات للأوامر لذلك هو يرسل أكثر من مرة

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

لا يمكنني تخمين موضع الحقول التي سيتم اظافتها يمكنك تعديله بنفس الطريقة عند اظافة حقول جديدة Sub TEST_MH2() Dim MT As Worksheet Dim lr As Long Set MT = Worksheets("sheet4") Application.ScreenUpdating = False lr = MT.Range("A" & Rows.Count).End(xlUp).Row MT.Range("F2:i" & lr).ClearContents With MT.Range("F2:F" & lr) .Formula = "=VLOOKUP(""*""&E2&""*"",A:D,1,0)" .Value = .Value With MT.Range("G2:G" & lr) .Formula = "=VLOOKUP(""*""&E2&""*"",A:D,2,0)" .Value = .Value With MT.Range("H2:H" & lr) .Formula = "=VLOOKUP(""*""&E2&""*"",A:D,3,0)" .Value = .Value With MT.Range("I2:I" & lr) .Formula = "=VLOOKUP(""*""&E2&""*"",A:D,4,0)" .Value = .Value End With End With End With End With Application.ScreenUpdating = True End Sub نسخة من نسخة officene _2.xlsm

كل الاحترام شكرا جزيلا في ميزان حسناتك

وعليكم السلام اخ جمال عن اي شي تريد البحث وفي اي جدول ..وعند الضغط على زر البحث مالذي يفتح من النماذج؟

أسماء الحقول في مثالك السابق أفضل عموما تمت المعالجة جدول الرواتب_03.accdb

لا يزال البرنامج يخبرك أنك لم تضف الدالة التالية لبرنامجك 🙂 : ' =================================(وهذه دالة لجعل الواتسأب يقبل السطور الجديدة في النص المرسل) Function ReplaceLineBreaks(text As String) As String ReplaceLineBreaks = Replace(text, vbCrLf, " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(10), " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(13), " %0a ") End Function أضفها في الأسفل تماما ( أسفل جميع الأكواد ) في نفس الصفحة مثلا .. وجرب من جديد

جزاكم الله خيرا @Mohamed Hicham

الكود طباعة الكل يعود إلى الصفحة 1 بعد أن يكمل عملية الطباعة... وبالنسبة للعدد الذي يصل إلى الآخر فهذا لا أستطيع أن أعرفه لأن البيانات Source غير موجودة في الملف.. الكارتة1.xlsm

السلام عليكم ورحمة الله محاولة في الملف... Book1.xlsm

السلام عليكم ورحمة الله وبركاته الأخ العزيز ارفع الملف وسوف يتم التعامل معه وارساله لك

وعليكم السلام ورحمة الله تعالى وبركاته تفضل اخي نسخة من officene.xlsm

جرب المثال جدول الرواتب_02.accdb

وعليكم السلام ارفع من فضلك الملف تجنباً لإهدار وقت الأساتذة دون جدوى !!!

غير هذا : إلى : Dim strMSG As String strMSG = " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || *" & Me.attach.Value & "* || " & "المرسل : *" & Me.sub strMSG = ReplaceLineBreaks(strMSG) Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & strMSG & "*" & "& app_sent =0" وهذا : إلى : objClipboard.SetText ReplaceLineBreaks(Me.msg)

للأسف ما استطعت تشغيله .. يظهر لي أخطاء ولا يعمل ..

أستاذ حمدي نسيت تشيل كود الدالة وتخليه في أي موديول عندك 🙂 وما دام مربع النص معاك اسمه MSG أيضا .. أفضل لك أن تغير اسم المتغير لاسم ثاني (strMSG) مثلا ... وذلك لتجنب حصول أخطاء في الكود

وعليكم السلام أستاذ حمدي .. في زر الارسال .. وقبل ما يشتغل الكود اللي يفتح الواتسأب .. تستبدل النص اللي حترسله ولنفرض أنه موجود في مربع النص Me.MsgText تستبدله بالنص الجديد اللي حتعطيك إياه الدالة اللي ذكرتها سابقا كما يلي : تعرف متغير جديد اسمه MSG علشان تحفظ فيه النص المراد إرساله بعد الاستبدال هكذا : Dim MSG as String MSG = ReplaceLineBreaks(Me.MsgText) وبعدها تخلي الواتسأب يرسل لك النص اللي متخزن في المتغير MSG .. 🙂

الحمدلله 🙂 جعفر

استخدمت مشاركة لاستاذي ابو خليل ودونت عليها تقريران راجعهم جيدا يمكن يفيدوك ووافني بالرد وذا لم يفيدك ارسل مرفقك !!! البحث بين وقتين معدل .rar

وهكذا الناتج السنوات المفقودة وآخر سنة سداد.accdb

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

السلام عليكم جرب الكود التالي (بتحفظ): Sub Conditional_Print() For I = 1 To 3 With Worksheets("ورقة" & I) .Activate If .Cells(3, 2) = "راسب" Or .Cells(3, 2) = "غائب" Then GoTo 1 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False End With 1 Next Worksheets("ورقة1").Activate End Sub

وعليكم السلام ورحمة الله تعالى وبركاته بعد ادن الاخوة الكرام بعض التعديلات البسيطة ربما تلبي المطلوب طلب وتعديل3.xlsm

الحمدلله جربته والأمور طيبة 🙂 فقط بقي إضافة تنبيهات التحقق من تعبئة جميع الحقول الأساسية مثل ( المبلغ - عدد الأقساط - تاريخ البداية - .... ) لأنها قد تعطي نتائج خاطئة أو رسائل خطأ .. 🙂

بسم الله الرحمن الرحيم مع بعض النهاردة هانتعلم الخدع البصرية في اليوزرفورم بطريقة بسيطة باستخدام Image Ctrl استخدمت مثال للشرح Dark Mood App Officana قم بتصميم الشكل بواسطة اي برنامج من برامج تحرير الصور او البوبوبينت بشرط ان تكون بنفس المقاسات مع اختلاف الالوان وفي اليوز نضيف Image Ctrl الملف بسيط ولا يحتوي الا اكواد الحركة للاداء معاينة الفورم https://youtu.be/VGL00cnLVF8 الملف بالمرفقات Dark Mood App Officana.xlsm وبالتوفيق للجميع

وعليكم السلام ورحمة الله تعالى وبركاته حياكم الله تعالى إخوتي. وأشكر أخي لطيب اهتمامه. بخصوص الطّلب؛ تيسّر هذان الموقعان للتّحويل بين أنساق الملفّات؛ مع العلم أنّي لم أقُم لتجربتهما؛ لكن أرجو أن ينتفع بهما إخوتي. الموقعان: https://www.idrsolutions.com/online-powerpoint-to-html5-converter https://www.zamzar.com/convert/ppt-to-html5/ وهذا شرح (فيديو): والله تعالى يُوفّق إخوتي.

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

السلام عليكم و رحمة الله تعالى و بركاته إخوتي الكرام حياكم الله أقدم لكم برنامج إستخراج أسماء الملفات و المجلدات الفرعية داخل مجلد دور البرنامج : استخراج اسماء الملفات الفرعية داخل مجلد و فتح الملف عند النقر مرتين على اسمه. شرح البرنامج: 1 - اختر النوع الذي تريد إظهاره المجلدات فقط أم المجلدات و الملفات معا 2- اختر المجلد الذي تريد استعراض ملفاته. 3- اضغط على الزر استخراج الملفات لظهور أسماء الملفات داخل مربع النص. 4- عند الضغط المزدوج على اسم الملف أو المجلد يقوم البرنامج بفتحه. أدعوا لي و لوالدي بالتسهيل في قرعة الحج إن شاء الله هذا هو البرنامج استخراج اسماء الملفات الفرعية لمجلد.rar

أخي الكريم تفضل شرح مبسط للكود Private Sub Worksheet_Change(ByVal Target As Range) 'إذا كان عدد الخلايا التي سيتم فيها التغيير أكثر من خلية يتم الخروج من الإجراء الفرعي If Target.Cells.CountLarge > 1 Then Exit Sub 'في حالة التعامل مع العمود الثاني والصف أكبر من 1 أي التعامل مع الصفوف بدايةً من الصف الثاني If Target.Row > 1 And Target.Column = 2 Then 'إلغاء خاصية تمكين الحدث Application.EnableEvents = False 'الخلية في العمود الثالث التالي للخلية الهدف يساوي 'قيمة الخلية الهدف التي يتم الكتابة فيها × الخلية في العمود الاول Target.Offset(0, 1).Value = Target.Value * Target.Offset(0, -1).Value 'استرجاع الخاصية مرة أخرى وتفعيلها Application.EnableEvents = True End If 'في حالة التعامل مع العمود الثالث والصف أكبر من 1 أي التعامل مع الصفوف بدايةً من الصف الثاني If Target.Row > 1 And Target.Column = 3 Then Application.EnableEvents = False 'الخلية في العمود الثاني السابقة للخلية الهدف تساوي 'قيمة الخلية الهدف التي في العمود الثالث / الخلية في العمود الأول Target.Offset(0, -1).Value = Target.Value / Target.Offset(0, -2).Value Application.EnableEvents = True End If End Sub

ممكن سؤال ...هو ليه كل الاستعلامات دي ؟ ربنا يعينك استاذ برناوي @Barna