أ / محمد صالح

تفضل تمت اعادة هيكلة جزء البحث في النموذج بالتوفيق التعديل على كود البحث.xlsm

يمكن رفع الملف على OneDrive ومشاركة الرابط مع الجميع مع فتح الملف بأوفيس 2016 وما بعده بالتوفيق

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

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

بارك الله لك وكل عام وانتم بخير وصحة وسعادة تم تغيير الامتداد لتقليل الحجم وإعادة رفع الملف

ربما يكون أحد غير إعدادات خطوط محرر الأكواد من قائمة tools اختر options ثم في تبويب editor format الخط الافتراضي courier new وحجم الخط 12 واختر اللون ولون الخلفية المفضل لديك بالتوفيق

يمكنك استخدام برنامج aopr بالبحث عن هذه الحروف في جوجل بالتوفيق

لعمل ذلك يمكنك: تحديد الخلايا B14:D14 من تبويب home نضغط على conditional formatting ثم new role ثم نختار الاختيار الثاني Format only cells that contain ثم Equal to ثم نكتب أو نختار B13 ثم نضغط على format لضبط لون الخلفية والنص المطلوب للخلية المميزة ثم OK مع مراعاة تطابق الأسماء في الخلايا مع الأسماء في القائمة بالتوفيق تلوين.xlsx

أي برنامج لتحرير ملفات pdf يمكنه فعلها لكن المشكلة في : هل ستظل متحركة أم لا؟

كل عام وأنتم بخير التنسيق الشرطي يتم إنشاؤه مرة واخدة فقط ويستمر عمله إلى أن يحذف ولتطبيق هذا الكود على أي شيت يمكنك تحديده ثم تنفيذ هذا الكود عليه مرة واحدة فقط سواء يدويا أو بكود في إجراء آخر مثل sub mrmas sheets("sheetname").select call CFext() sheets("sheetname2").select call CFext() sheets("sheetname3").select call CFext() end sub بالتوفيق

يمكنك استعمال هذه الدالة لتحويل النص العربي من رموز غريبة إلى utf8 وذلك بإضافة هذا الكود في موديول جديد في شاشة الفيجوال بيسك للتطبيقات vba بالضغط على alt+f11 ثم من قائمة insert نختار module ثم نلصق هذا الكود Function masAr2Utf(inputStr As String) As String Dim n As Integer, i As Integer, inBytes() As Byte, sUnicode As String n = Len(inputStr) ReDim inBytes(n + 1) For i = 1 To n inBytes(i) = AscB(Mid(inputStr, i, 1)) Next sUnicode = StrConv(inBytes, vbUnicode, &H401) iPos = InStr(sUnicode, Chr(0)) If iPos > 0 Then sUnicode = Mid(sUnicode, iPos + 1) masAr2Utf = sUnicode End Function وطريقة استدعائها في الشيت نكتب في الخلية المراد ظهور النص العربي بها =masAr2Utf(B2) بالتوفيق

أبسط حل أن تعكس التاريخ بكتابة العام ثم الشهر ثم اليوم وإذا كنت تأخذ التاريخ من خلية أخرى فيمكن استعمال هذه المعادلة ="كتابنا ذي الرقم (1254) في "&TEXT(C4,"yyyy/mm/dd") على اعتبار أن خلية التاريخ هي C4 بالتوفيق

أخي الكريم الحمد لله لي السبق في هذا المجال الترجمة بالكود في vba وغيرت الكود مرة في 2017 ومرة في 2019 ولم أهتم بعدها بهذه الطريقة وبالنسبة لملفكم بالنسبة للرابط المستععمل قي الكود فهو خاص بنسخة الموبايل https://translate.google.com/m?sl=auto&tl=ar&hl=en-US&q=Good+morning ولا يوجد به زر للنطق والكود يستعمل زر له كلاس .Document.QuerySelector(".VfPpkd-Bz112c-kBDsod-OWXEXe-IT5dJd").Click وهو غير موجود وبالنسبة لطلب صفحة الترجمة الكاملة فالنطق يكون غير مدعوم في متصفح انترنت اكسبلورر المستخدم في الكود Voice output isn't supported on this browser خلاصة الكلام: أن هذه الطريقة لنطق النص أصبحت غير متاحة وكنت قد أوضحت أنه يوجد طريقة أخرى أستعملها في موقعي الشخصي mr-mas.com ولكن لم أحولها إلى vba لانشغالي هذه الفترة ولاني مستاء جدا من نشر أكوادي باسم غيري فلا يوجد في مصر والعالم العربي ما يسمى بالأمانة العلمية ربما لاحقا أحول هذه الطريقة إلى vba بالتوفيق

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

عليكم السلام ورحمة الله وبركاته يمكنك استعمال هذا الكود في حدث عند التغيير Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$G$2" Then Call ter End If End Sub كلك يمين على اسم الشيت ثم view code ثم لصق في الناحية اليمنى بالتوفيق

الحمد لله الذي وفقنا لهذا

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

الحمد لله الذي وفقنا لهذا

بعد إذن حبيبنا @omar elhosseini يمكنك استعمال هذه الأكواد في صفحة Rooming list كلك يمين ثم view code ثم تلصق هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Or Target.Row <= 2 Then Exit Sub If Target.Column = 3 And Target.Value <> "" And Not (sheetExists(Target.Value)) Then Call newsh(Target.Value) End If End Sub Function sheetExists(sheetToFind As String) As Boolean sheetExists = False For Each Sheet In Worksheets If sheetToFind = Sheet.Name Then sheetExists = True Exit Function End If Next Sheet End Function Sub newsh(newname As String) OptimizeVBA 1 Sheets("Aqua Park HRG").Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = newname ActiveSheet.Range("K2") = newname OptimizeVBA 0 End Sub Sub OptimizeVBA(isOn As Boolean) Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic) Application.EnableEvents = Not (isOn) Application.ScreenUpdating = Not (isOn) ActiveSheet.DisplayPageBreaks = Not (isOn) End Sub وبه من كنوز مكتبتي الخاصة الكثير من التحف التأكد من وجود اسم الشيت تحسين سرعة الأكواد في vba بالتوفيق

يمكنك استعمال دالة offset Sub offsetplus() ActiveCell.Value = ActiveCell.Offset(0, -3).Value + 3 End Sub مع ملاحظة 0 تعني في نفس الصف رقم -3 تعني الخلية الثالثة السابقة رقم +3 تعني الرقم الذي يتم إضافته بالتوفيق

لو أمكن رفع الملف الخاص بالأستاذة حتى نرى هل يمكن التعديل عليه

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

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

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

بعد إذن حبيبنا @Ali Mohamed Ali هذه محاولة لعرض تقرير الغياب الشهري لجميع الأقسام بصورة يمكن طباعتها بعد إخفاء الأعمدة الفارغة بالتوفيق تقرير غياب الموظفين في شهر.xlsx