كل الانشطه

ما شاء الله ، مبدع فيما طرحت . أثار الموضوع اهتمامي سابقاً في مناقشة سابقة ومداخلة قوية لك ، مما جعلني أتحرى عن موضوع الحقن بشكل عميق وأحاول تنفيذه في مشاريعي تالياً .. ومن سياق الحديث الذي طرحته ، اعتقد أن استخدام المعلمات بدلاً من سلاسل نصية سيكون من خطوات الأمان التي قد يجب تنفيذها . أيضاً على ما أعتقد استخدامنا لمطهرات النصوص قد يأتي بنتيجة جيدة ومساعدة ,, على سبيل المثال ، هذه فكرة بسيطة أيضاً وقد تكون قابلة للتطوير والتحديث بشمولية ,, If InStr(Me.txtUser, "'") > 0 Or InStr(Me.txtUser, ";") > 0 Then MsgBox "تم استخدام رموز غير مسموح بها في اسم المستخدم", vbExclamation Exit Sub End If ولهذا السبب كنت قد استخدمت محاولة لم أقم بتجربتها بعد ، على أحد المشاريع باستخدام هذه الدالة :- Public Function Sanitizer(ByVal userInput As String, Optional ByVal context As String = "sql") As String Dim sanitized As String sanitized = Trim(userInput) Select Case LCase(context) Case "sql" sanitized = Replace(sanitized, "'", "''") sanitized = Replace(sanitized, ";", "") sanitized = Replace(sanitized, "--", "") Case "name" sanitized = Replace(sanitized, "'", "") sanitized = Replace(sanitized, ";", "") sanitized = Replace(sanitized, "*", "") sanitized = Replace(sanitized, "=", "") Case "pure" Case Else sanitized = Replace(sanitized, "'", "''") End Select Sanitizer = sanitized End Function وعلى سبيل المثال كإستخدام في الاستعلامات :- Dim filter As String filter = "[U_UserName]='" & Sanitizer(Me.txtUser, "sql") & "' AND [U_Password]='" & Sanitizer(Me.txtPass, "sql") & "'" DoCmd.OpenForm "frmDashboard", , , filter وكمثال على ما طرحته سابقاً لفتح نموذج بفلترة .. DoCmd.ApplyFilter , "[U_UserName]='" & Sanitizer(Me.txtSearch, "sql") & "'" أو حتى في نموذج تسجيل الدخول لاسم المستخدم ، كانت المحاولة :- Dim newUser As String newUser = Sanitizer(Me.txtNewUser, "name") هذه كانت الفكرة التي خطرت لي ، ولكن لاحقاً قمت بتحديثها لإظهار رسالة تحذيرية تلقائية إذا تم رصد مدخل خطير أو محاولات حقن نصية 😁

يرجى المساعدة باستخراج تقرير شهرى ( لكل السنة) لمتوسط قيمة منتجات على ان يكون الشكل كالتالى: الصف يناير فبراير الى اخر شهر العامود يتكون من مجموعة من المنتجات جزاكم الله خيرا شهر 12022.zip

في المعايير النصية لبعض الاستعلامات نستخدم WHERE U_UserName = '" & strUser & "' AND U_Password = '" & strPass & "'") وكذلك الحال في دوال تجميع المجال "[U_FullName]='" & [tx3] & "'") ايضا عندما نضع معيار نصي لفتح فورم من خلال فورم اخر DoCmd.OpenForm "frm2", , , "[U_UserName]='" & [tx2] & "'" وكذلك الحال عند الفلترة بمعيار نصي DoCmd.ApplyFilter , "[U_UserName]='" & [tx9] & "'" وحيث ان الحقول النصية تقبل كتابة أي احرف أو أرقام أو رموز خاصة وبالتي يمكن توظيفها بطريقة معينة لتنفيذ اجراء غير شرعي الحقيقة التي يعلمها اي شخص لديه خبرة في الحماية أن الرموز الخاصة ورسائل الخطأ غير المعالجة تمثل الطريق الأسهل للاختراق في الحالة الاولى معيار نصي في استعلام يمكن تسجيل دخول غير شرعي بكافة صلاحيات مستخدم رقم 1 ويمكن تنفيذ استعلام حذف او الحاق او او ... الخ في حالة رقم 2 مع دوال تجميع المجال يمكن تنفيذ الدالة دون معرفة المعيار وتعود باول او اخر او اكبر سجل وفقا لنوع الدالة في الحالة الثالثة نحتاج أحيانا لفتح فورم وإحضار بيانات محددة للعرض و يمكن من خلال توظيف الرمز فتح الفور مع اول سجل او كافة السجلات ويمكن استعراضها والتنقل بينها هنا لا داعي لمعرفة المعيار فقط رموز ونجوم يتم كتابتها بطريقة معينة وكذلك في الحالة الرابعة الفلترة يمكن فلترة كافة البيانات والتنقل بدون الحاجة لمعرفة المعيار والسؤال هل هذا هو الرمز الوحيد الذي يمكن استغلاله (') الاجابة لا ولكن ركزنا عليه لكونه الأكثر استخدام في قاعدة البيانات اخيرا هل يمكن انهاء المشكلة وخصوصا ان الرمز مطلوب للمعايير النصية نعم يمكن بتتبع المدخلات للحقول النصية المرتبطة باجراء ومن اسهل الطرق استخدام دالة Replace strPass = Replace(Me.U_Password, "'", "_") ايضا استخدام رسائل معالجة الاخطاء وتحديد الاجراء عند حدوث خطأ ونكتفي بهذا القدر عن الرمز (') وقد نتحدث غن رمز اخر لايقل خطورة والله الموفق الشايب

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

الاخ العزيز hegazee احتاج المتوسط لكل صنف فى الشهر حيث يكون بالشكل التالى: الصف يتكون من اسماء الاشهر والعامو يكون به: jan feb mar apr may jun jul aug sep oct nov dec طماطم ذرة الخ اعتذر على الازعاج

جزاك الله خيرا

حاول ترفع أي ملف فيه مشكله هنا. و إذا كان حجمه كبير ارفعه على جوجل درايف

تفضل الملف . حطيت بعض المعلومات العشوائية لاختبار المعادلة شهر 12022(2).xlsx

الاوفيس وجدته 64 bit ولم تحل المشكلة للاسف اذا في اقتراحات اخرى

وعليكم السلام ورحمة الله تعالى وبركاته =TEXT((A4-INT(A4))*1000,"000")

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

السلام عليكم ورحمة الله وبركاته المطلوب استخراج الكسور من العدد المدون في العمود A وكتابة في العمود C مثال : في الخلية A4 القيمة العددية : 1796.630 والمطلوب كتابة 630 بطريقة آلية ( باستخدام المعادلات أو الأكواد ) في الخلية C4 الملف المرفق يوضح يطريقة أفضل تجربة_فصل الكسور من العدد في خلية مستقلة.xlsx

وعليكم السلام ورحمة الله وبركاته .. في مرفقك ، الورقة "MD1 15-2020-16" موجودة في الأساس ، وأنت تريد ترحيل البيانات اليها مسبقاً ، ثم تريد انشاء نسخة من الورقة Main بنفس الاسم الموجود في الخلية B2 في Main صحيح !!!! وضحها اذا سمحت 😅

تفضل أخي الكريم ، محاولتي البسيطة . حيث في الورقة الثانية = موقف الغياب اليومي ، قمت بإضافة زر للتحديث ، وتم استدعاءه للدالة التي تم انشاؤها في مديول عام :- Sub ExtractAbsentEmployees() Dim wsMain As Worksheet Dim wsReport As Worksheet Dim targetDate As Date Dim dayNum As Integer Dim targetCol As Integer Dim lastRow As Long Dim i As Long Dim reportRow As Long Set wsMain = ThisWorkbook.Sheets("MainSheet") Set wsReport = ThisWorkbook.Sheets("موقف الغياب اليومي") wsReport.Range("A5:D" & wsReport.Rows.Count).ClearContents targetDate = wsReport.Range("C2").Value dayNum = Day(targetDate) targetCol = 3 + dayNum If targetCol < 4 Or targetCol > 34 Then MsgBox ".تاريخ غير صالح يجب أن يكون اليوم بين 1 و 31", vbExclamation Exit Sub End If lastRow = wsMain.Cells(wsMain.Rows.Count, "B").End(xlUp).Row reportRow = 5 For i = 4 To lastRow If wsMain.Cells(i, targetCol).Value = "غ" Then wsReport.Cells(reportRow, 1).Value = wsMain.Cells(i, 1).Value wsReport.Cells(reportRow, 2).Value = wsMain.Cells(i, 2).Value wsReport.Cells(reportRow, 3).Value = wsMain.Cells(i, 3).Value wsReport.Cells(reportRow, 4).Value = targetDate reportRow = reportRow + 1 End If Next i If reportRow = 5 Then MsgBox "لا يوجد موظفين متغيبين في هذا التاريخ", vbInformation End If End Sub وفي الورقة الثالثة "موقف الغياب الشهري" ، أيضاً تم انشاء زر لاستدعاءه الدالة التالية من نفس المديول :- Sub GenerateMonthlyAbsenceReport() Dim wsMain As Worksheet Dim wsReport As Worksheet Dim startDate As Date, endDate As Date Dim currentDate As Date Dim dayNum As Integer, targetCol As Integer Dim lastRow As Long, reportRow As Long, i As Long Dim empName As String, empJob As String Dim dateList As String, dayList As String Dim dateCount As Integer Dim dayName As String Set wsMain = ThisWorkbook.Sheets("MainSheet") Set wsReport = ThisWorkbook.Sheets("موقف الغياب الشهري") If Not IsDate(wsReport.Range("C2").Value) Or Not IsDate(wsReport.Range("C3").Value) Then MsgBox "الرجاء إدخال تاريخين صالحين في الخلايا C2 و C3", vbExclamation + vbMsgBoxRight, "" Exit Sub End If startDate = wsReport.Range("C2").Value endDate = wsReport.Range("C3").Value If startDate > endDate Then MsgBox "خطأ: تاريخ البداية يجب أن يكون قبل تاريخ النهاية", vbExclamation + vbMsgBoxRight, "" Exit Sub End If Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With wsReport .Range("A6:F" & .Rows.Count).ClearContents .Range("6:" & .Rows.Count).RowHeight = 15 End With lastRow = wsMain.Cells(wsMain.Rows.Count, "B").End(xlUp).Row reportRow = 6 For i = 4 To lastRow empName = wsMain.Cells(i, 2).Value empJob = wsMain.Cells(i, 3).Value If empName = "" Then GoTo NextEmployee dateList = "" dayList = "" dateCount = 0 currentDate = startDate Do While currentDate <= endDate dayNum = Day(currentDate) targetCol = 3 + dayNum If targetCol >= 4 And targetCol <= 34 Then If wsMain.Cells(i, targetCol).Value = "غ" Then dayName = wsMain.Cells(2, targetCol).Value If dateList <> "" Then dateList = dateList & vbLf & Format(currentDate, "yyyy-mm-dd") dayList = dayList & vbLf & dayName Else dateList = Format(currentDate, "yyyy-mm-dd") dayList = dayName End If dateCount = dateCount + 1 End If End If currentDate = DateAdd("d", 1, currentDate) Loop If dateCount > 0 Then With wsReport .Cells(reportRow, 1).Value = reportRow - 5 .Cells(reportRow, 2).Value = empName .Cells(reportRow, 3).Value = empJob .Cells(reportRow, 4).Value = dateCount .Cells(reportRow, 5).Value = dateList .Cells(reportRow, 6).Value = dayList .Cells(reportRow, 5).WrapText = True .Cells(reportRow, 6).WrapText = True If dateCount > 1 Then .Rows(reportRow).RowHeight = 15 * dateCount End If End With reportRow = reportRow + 1 End If NextEmployee: Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic If reportRow > 6 Then ' MsgBox "تم إنشاء التقرير بنجاح", vbInformation + vbMsgBoxRight, "" Else MsgBox "لا توجد أيام غياب في الفترة المحددة", vbInformation + vbMsgBoxRight, "" End If End Sub وتركت لك التعديل متاحاً من خلال تحديد الصف أو العمود ... إلخ . وهذا ملفك بعد التعديل . راجعه وأخبرنا بالنتيجة .. موقف غياب موظفين.zip

مرفق الملف شهر 12022.zip

السلام عليكم ورحمة الله وبركاته اخواتي في الله مطلوب كود يقوم بترحيل المكتوب في شيت Main في الخليه C8 الى اسم الشيت المكتوب في الخليه B2 يقوم بترحيلها بالترتيب في العمود B6 ثم يقوم بنسخ شيت NEW وفتح شيت جديد باسم الخليه B2 في شيت Main وان امكن ان يعمل ربط تشعبي اذا امكن تطبيقها على الملف المرفق جعله الله في موازين حسناتكم BB.xlsm

المشكلىة الملف كبير فيه تقريبا 20 الف صف وحجمه كبير هذا صورة من بيانات الملف price الكمية الصنف التاريخ 0.850 70 خيار 01-Jan-22 0.075 42 جرجير 01-Jan-22 0.850 232 خيار 01-Jan-22 0.850 30 خيار 01-Jan-22 1.000 23 باذنجان 01-Jan-22 1.000 13 كزبرة 01-Jan-22

من الأفضل رفع ملف ليتم العمل عليه

تفضل Sub FormatUniqueCellsInRow() Dim ws As Worksheet Dim lastRow As Long, startRow As Long Dim r As Long, i As Long, j As Long Dim values(1 To 7) As Variant Dim count As Long Dim data As Variant On Error GoTo ErrorHandler Set ws = ThisWorkbook.Sheets("Sheet1") ' تأكد من تغيير "Sheet1" إلى اسم الورقة الفعلي startRow = 3 ' الصف الذي تبدأ منه البيانات lastRow = ws.Range("C3:I" & ws.Rows.Count).Find(What:="*", _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ' تنظيف التنسيقات السابقة من الأعمدة C:I و O With ws.Range("C" & startRow & ":I" & lastRow & ",O" & startRow & ":O" & lastRow) .Interior.ColorIndex = xlNone .Font.ColorIndex = xlAutomatic .Font.Bold = False End With ' تحميل النطاق إلى مصفوفة data = ws.Range("C" & startRow & ":I" & lastRow).Value ' المرور على كل صف For r = 1 To lastRow - startRow + 1 ' تخزين قيم الصف الحالي For i = 1 To 7 values(i) = data(r, i) Next i ' فحص القيم الفريدة For i = 1 To 7 count = 0 If Not IsEmpty(values(i)) Then For j = 1 To 7 If CStr(values(j)) = CStr(values(i)) Then count = count + 1 End If Next j ' إذا كانت القيمة فريدة If count = 1 Then ' تطبيق التنسيق على الخلية في C:I With ws.Cells(r + startRow - 1, i + 2) .Interior.Color = RGB(255, 255, 0) ' تعبئة صفراء .Font.Color = RGB(255, 0, 0) ' خط أحمر .Font.Bold = True ' خط عريض End With ' تطبيق نفس التنسيق على الخلية في العمود O في نفس الصف With ws.Cells(r + startRow - 1, "O") .Interior.Color = RGB(255, 255, 0) ' تعبئة صفراء .Font.Color = RGB(255, 0, 0) ' خط أحمر .Font.Bold = True ' خط عريض End With End If End If Next i Next r MsgBox "تمت معالجة البيانات بنجاح!", vbInformation Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical End Sub

لدى جدول مكون من التاريخ والكمية والصنف وسعر العبوة واريد استخراج تقرير لكل شهر لاعلى قيمة لكل صنف حسب الشهر حسب الأشهر 1 2 3 4 5 6 7 8 9 10 11 12 طماطم فلفل حلو خيار خس بروكلى كزبرة ملفوف بقدونس باذنجان لوبيا اشبنت نعناع

تحويل الدالة الى دالة عامة ، يتم استدعائها في أي نموذج ، توسيع الفكرة اختيار التاريخ لا يعمل بشيت b-c-d.xlsm

هذا الكود الصحيح بخصوص تنسيق الاعمدة المختلفة من العمود C حتى العمود I هل يمكن اضافة ودمج كود خاص بتنسيق العمود المحدد فى العمود O Sub FormatUniqueCellsInRow() Dim ws As Worksheet Dim lastRow As Long Dim r As Long Dim values(1 To 7) As Variant ' لتخزين القيم من C إلى I (7 أعمدة) Dim i As Integer, j As Integer Dim count As Integer ' 1. إعدادات ورقة العمل Set ws = ThisWorkbook.Sheets("Sheet1") ' ?? غيّر "Sheet1" إلى اسم ورقتك الفعلي ' 2. تحديد آخر صف يحتوي على بيانات في العمود C lastRow = ws.Cells(ws.Rows.count, "C").End(xlUp).Row ' 3. تنظيف أي تنسيقات سابقة من الأعمدة C إلى I ' هذا مهم لضمان تطبيق التنسيقات الجديدة فقط ws.Range("C3:I" & lastRow).Interior.ColorIndex = xlNone ' مسح لون التعبئة ws.Range("C3:I" & lastRow).Font.ColorIndex = xlAutomatic ' مسح لون الخط المخصص ws.Range("C3:I" & lastRow).Font.Bold = False ' إلغاء الخط العريض ' 4. المرور على كل صف بدءًا من الصف 3 (أو أي صف تبدأ منه بياناتك) For r = 3 To lastRow ' ابدأ من الصف الذي تبدأ منه بياناتك ' قراءة القيم من العمود C إلى I للصف الحالي وتخزينها في مصفوفة ' Column C is index 1 (i + 2 where i=1 means 1+2=3 which is C) For i = 1 To 7 values(i) = ws.Cells(r, i + 2).Value ' i+2 لأن C هو العمود الثالث Next i ' فحص كل قيمة في الصف لتحديد إذا كانت فريدة داخل هذا الصف For i = 1 To 7 ' تكرار على كل عمود من C إلى I (بواسطة فهرس المصفوفة i) count = 0 ' إعادة تعيين العداد لكل قيمة ' مقارنة القيمة الحالية (values(i)) بجميع القيم الأخرى في نفس الصف For j = 1 To 7 If values(j) = values(i) Then count = count + 1 End If Next j ' إذا كانت القيمة فريدة (تكررت مرة واحدة فقط في الصف) If count = 1 Then ' تطبيق التنسيق على الخلية المحددة التي تحتوي على القيمة الفريدة With ws.Cells(r, i + 2) ' i + 2 يمثل رقم العمود الفعلي (C, D, E...) .Interior.Color = RGB(255, 255, 0) ' تعبئة صفراء (RGB for exact yellow) .Font.Color = RGB(255, 0, 0) ' خط أحمر (RGB for exact red) .Font.Bold = True ' خط عريض End With End If Next i Next r ' إذا كنت لا تزال ترغب في الاحتفاظ بالعمود O بالنص الوصفي، يمكنك ترك الكود الخاص بك ' Sub CheckDifferences() وتشغيله بعد هذا الكود، أو دمج المنطق هنا. ' لكن هذا الكود يركز فقط على تنسيق الخلايا من C إلى I. End Sub

قد سبقني السباقون الأساتذة .. ما شاء الله عليهم .. عذراً للتأخر في الرد ، ولكن يبدوا أنهم قد أجادوا بما طرحوا ، ويسعدني نقلك للإجابة لأي حل آخر تراه مناسباً لك ( بصدر رحب طبعاً ) .

معلمي الفاضل ، اعتذر عن التأخر بالرد ، ولكن فعلاً تفاجأة بضيوفي من العائلة 😅 ولوقت متأخر لم أتمكن من المتابعة ,, على العموم ، وبما انك رأيت ان فكرة الحقلين هي الأنسب لك والأوفر والأقل جهداً ، قد يكون قرارك صائباً برؤية أبعد .. على العموم بانتظار مرفقك المعدل ، ومتابع معك .

ممتاز اخواتي الكرام شكرا استاذ حجازي والف شكر استاذي الفاضل محمد هشام جعله الله في موازين حسناتكم