كل الانشطه

نعم اخي الفاضل

اخوي بلال ، من باب التوضيح أكثر لك . انت تريد عند النقر مرتين على اسم الصورة ان يتم اظهار رسالة تكتب فيها اسم الصورة الذي تريده ؟؟؟

يكون اسم الصورة عند اختيارها ونقوم بتعديل

ما في مشكلة أخي الكريم ، بس سؤالنا ؟ ماذا تريد ان يكون اسم الصورة عند اختيارها ؟؟؟؟؟؟؟؟

اليك التوضح

بصراحة ما فهمت

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

لم تقم بتوضيح ماذا تريد ان يكون اسم الصورة ؟ رقم الموظف مثلاً !!!

السلام عليكم ورحمة الله وبركاته رجعت للقاعدة الاصلية بشمهندس - وقد ارفقتها - ووجدتها تشتغل بكفاءة وعندما حاولت ان اغير مسمى النموذج frmrisale ولكن لم تنجح المحاولة والصراحة احترت . ففي القاعدة الاصلية الامور تمام والقاعدة المرفقة سابقا يظهر هذا الخطاء Backup.rar

اخي اين اضع الكود اريد تعديل على اسم الصورة

أولاً ، وعليكم السلام ورحمة الله وبركاته .. ثانياً لا أعتقد أنها صدفة للبيانات التي في السجل الوحيد في الجدول 😅😅 الإسم وتاريخ الميلاد ، والوظيفة 🤔 = جميعها تخصني ( هي ليست سرية ، ولكني استغربت 😁 ) على العموم ، ومشاركة مع معلمي الأستاذ @منتصر الانسي :- لاحظت انك استخدمت تكرار المتغير m مرات عديدة في جميع الأجزاء ، ولذا أقترح عليك ان تقوم بتعريفه كمتغير في بداية النموذج لتخزين مسار الملفات . وهذا مقترحي كاملاً بعد إجراء بعض التغييرات :- Option Compare Database Private m_ImagePath As String Sub ImageLoad() On Error Resume Next m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID List31.RowSource = "" List31.RowSource = Left(GetAllFile(m_ImagePath), Len(GetAllFile(m_ImagePath)) - 1) End Sub Private Sub Command42_Click() On Error Resume Next m_ImagePath = CurrentProject.Path & "\SysFiles\" & Me.ID Dim newFileName As String newFileName = AddNewFile(Me.ID) Image16.Picture = m_ImagePath & "\" & newFileName Call ImageLoad Me.Path = m_ImagePath & "\" & newFileName If Not IsNull(newFileName) Then List31.Value = newFileName End If End Sub Private Sub Command43_Click() On Error Resume Next If IsNull(List31) Then Exit Sub If MsgBox("هل تريد فعلا حذف الصورة المحددة" & vbNewLine & List31, vbMsgBoxRight + vbYesNo + vbQuestion, "تأكيد الحذف") = vbYes Then m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID Kill (m_ImagePath & "\" & List31) Call ImageLoad Image16.Picture = "" Image16.Requery End If End Sub Private Sub Form_Current() On Error Resume Next Call ImageLoad Me.Form.Caption = IIf(IsNull(Me.الاسم), "", Me.الاسم) Image16.Picture = "" Auto_Header0.Caption = "الأرشيف الالكتروني للموظف" & " : " & Me.الاسم End Sub Private Sub List31_Click() On Error Resume Next m_ImagePath = CurrentProject.Path & "\" & "SysFiles" & "\" & Me.ID Image16.Picture = m_ImagePath & "\" & List31 Me.Path = m_ImagePath & "\" & Me.List31 End Sub

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

السلام عليكم ورحمة الله وبركاته اسف للعودة للموضوع فلم اكمل كل الاختبارات المطلوبة بعد انحلت مشكلة اختيار مكان القاعدة واختيار مكان المجلد المطلوب النسخ فيه احتياطيا ظهر خطاء اتناء تنفيد النسخ الاحتياطي كما هو مبين بالصورة المرفقة

يا هلا والله باستاذى القدير و معلمى الجليل الاستاذ @منتصر الانسي هذا الحل ينفع بس فى حالة واحدة فتح التقرير : DoCmd.OpenReport strRptName, acViewPreview ولكن لو اردت الطباعة : DoCmd.OpenReport "Period Report", acViewNormal للاسف لو ما فى بيانات سوف يتم طباعة ورقة بيضاء

الصورة.rar

مع إحترامي لحل الأخ @ابو جودي فالمسألة أبسط من كذا كل ماعليك فعله هو إضافة الكود التالي لحدث عند عدم وجود بياتات أو On No Data الخاص بالتقرير 'رسالة تنبيه MsgBox "لايوجد أي بيانات في التقرير", vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه" 'إلغاء الأمر وعدم متابعة فتح التقرير Cancel = -1 ليصبح بهذا الشكل Private Sub Report_NoData(Cancel As Integer) 'رسالة تنبيه MsgBox "لايوجد أي بيانات في التقرير", vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه" 'إلغاء الأمر وعدم متابعة فتح التقرير Cancel = -1 End Sub مع تحياتي

من إطلاعي على الملف فأنت تريد أن الصور التي بإسم CompanyLogo و StampLogo أن تكون عامة لكل الفروع والصور BranchLogo تكون متغيرة بحسب الفرع أليس كذلك؟ إذا كان الوضع بهذا الشكل فيجب عليك عدم ربط الصورتين CompanyLogo و StampLogo بالحقل لأنه يفترض أن الشركة واحدة عموما قمت بتعدبل الملف جرب فتح التقرير بزر المعاينة للسجلين الاول والثاني وكذا فتحه مباشر بالنقر المزدوج على التقرير هل هذا التعديل هو ماتطلبه أم شيئ آخر لأن شرحك غير واضح مع تحياتي DDCompanyLogos.rar

السلام عليكم عند تحميل الصورة في النموذج ومعاينة تقرير لا توجد صورة وعند حدف صورة حتى نخرج من نموذج DDCompanyLogos.rar

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

السلام عليكم ورحمة الله وبركاته سوف أقدم وحدة نمطية عامة متقدمة تتيح لك فتح أي تقرير في الاكسس بطريقة ديناميكية مع التحقق من وجود التقرير ومصدر بياناته واحتوائه على بيانات قبل العرض أو الطباعة الخصائص والمميزات تحقق تلقائي من وجود التقرير قبل عرضه دعم التصفية من خلال تمرير شروط WhereCondition لتحديد البيانات ادارة المصدر وذلك من خلال استخراج RecordSource بشكل ديناميكي مع التخزين المؤقت داخل قاموس مرونة التعامل مع اوضاع التقارير المختلفه بحيث يدعم الطباعة - المعاينة - او اى وضع عرض الصمت المطلق للاستخدامات البرمجية من خلال اختيار تفعيل الوضع "بدون رسائل" للاستخدام البرمجى عند الحاجة بدون ازعاج استجابة ذكية ومعالجة اخطاء احترافية من خلال تعامل متكامل مع الأخطاء الشائعة تقريبا طريقة الدمج في مشاريعك و قواعد بياناتك : ضع الكود فى وحدة نمطية عامة مثلا باسم : basReportUtils استدعِ الدالة OpenReportSmart كما يناسب سيناريو العرض الذى تفضلة او المعالحة التى ترغب بها يمكن تمرير المعلمات بسهولة أو الاعتماد على القيم الافتراضية المستخدمة فى التكويد وأخيرا الكود المستخدم داخل الوحدة النمطية : basReportUtils ' __ ' / /\ ' / / \www.officena.net™ ' / / \__________ ' / / \ /\ ' /_/ \ / / ' ___\ \ ___\____/_/_ ' /____\ \ /___________/\ ' \ \ \ \ \ \ ' \ \ \ \____ \ \ ' \ \ \ / /\ \ \ ' \ / \_\/ / / \ \ ' \ / / /__________\/ ' / / / / ' /ابو جودى/ / / ' /________/ /\ / 21/07/2025 ' \________\/\ \ / منتديات أوفيسنا عالم من الابداع ' \_\/_____________________________________ Option Compare Database Option Explicit '' ==== متغير خاص لتخزين مؤقت لمصادر البيانات ==== ' --- Dictionary لتخزين RecordSource للتقارير Private m_dictRecordSource As Object '' ==== دالة: التحقق من وجود تقرير داخل قاعدة البيانات ==== Private Function ReportExists(ByVal strReportName As String) As Boolean On Error Resume Next ReportExists = Not CurrentProject.AllReports(strReportName) Is Nothing On Error GoTo 0 End Function '' ==== دالة: الحصول على مصدر البيانات لتقرير معين مع تخزين مؤقت ==== Private Function GetRecordSource(ByVal strReportName As String) As String If m_dictRecordSource Is Nothing Then Set m_dictRecordSource = CreateObject("Scripting.Dictionary") End If If m_dictRecordSource.Exists(strReportName) Then GetRecordSource = m_dictRecordSource(strReportName) Exit Function End If On Error GoTo ErrHandler DoCmd.OpenReport strReportName, acDesign, , , acHidden GetRecordSource = Trim(Reports(strReportName).RecordSource) DoCmd.Close acReport, strReportName, acSaveNo m_dictRecordSource.Add strReportName, GetRecordSource Exit Function ErrHandler: GetRecordSource = "" End Function '' ==== دالة: التحقق من احتواء التقرير على بيانات ==== Private Function ReportHasData(ByVal strReportName As String, ByVal strRecordSource As String, _ Optional ByVal strWhereCondition As String = "", _ Optional ByVal strOpenArgs As String = "") As Boolean Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim qdf As DAO.QueryDef Dim lngCount As Long Dim bolIsQuery As Boolean On Error GoTo ErrHandler Set dbs = CurrentDb ''---- التحقق مما إذا كان strRecordSource يشير إلى استعلام محفوظ On Error Resume Next Set qdf = dbs.QueryDefs(strRecordSource) If Err.Number = 0 Then bolIsQuery = True Else Err.Clear bolIsQuery = False End If On Error GoTo ErrHandler ''---- محاولة حساب عدد السجلات If bolIsQuery Or InStr(1, strRecordSource, "SELECT", vbTextCompare) = 1 Then On Error Resume Next If bolIsQuery Then ''---- إذا كان استعلامًا محفوظًا، تحقق من المعلمات If qdf.Parameters.Count > 0 Then ReportHasData = False ' لا يمكن معالجة معلمات بدون قيم GoTo CleanUp End If Set rst = qdf.OpenRecordset(dbOpenSnapshot, dbReadOnly) Else ''---- إنشاء استعلام مؤقت مع strWhereCondition Dim strSQL As String strSQL = strRecordSource If Len(strWhereCondition) > 0 Then strSQL = strSQL & " WHERE " & strWhereCondition End If Set rst = dbs.OpenRecordset(strSQL, dbOpenSnapshot, dbReadOnly) End If If Err.Number = 0 Then lngCount = IIf(rst.EOF, 0, rst.RecordCount) rst.Close Set rst = Nothing Else Err.Clear lngCount = 0 End If On Error GoTo ErrHandler Else On Error Resume Next lngCount = Nz(DCount("*", strRecordSource, strWhereCondition), 0) If Err.Number <> 0 Then Err.Clear lngCount = 0 End If On Error GoTo ErrHandler End If ''---- إذا لم يكن هناك سجلات، تحقق من HasData If lngCount = 0 Then On Error Resume Next DoCmd.OpenReport strReportName, acViewPreview, , strWhereCondition, acHidden, strOpenArgs If Err.Number = 0 Then ReportHasData = Reports(strReportName).HasData DoCmd.Close acReport, strReportName, acSaveNo Else Err.Clear ReportHasData = False End If On Error GoTo ErrHandler Else ReportHasData = True End If CleanUp: If Not rst Is Nothing Then rst.Close Set rst = Nothing End If If Not qdf Is Nothing Then Set qdf = Nothing End If Set dbs = Nothing Exit Function ErrHandler: ReportHasData = False GoTo CleanUp End Function '' ==== إجراء عام: عرض تقرير بعد التحقق من وجوده واحتوائه على بيانات من وجود بيانات وطلب تأكيد الطباعة ==== Public Sub OpenReportSmart(ByVal strReportName As String, _ Optional ByVal bolAskToPrint As Boolean = True, _ Optional ByVal strViewMode As AcView = acViewNormal, _ Optional ByVal strWhereCondition As String = "", _ Optional ByVal strOpenArgs As String = "", _ Optional ByVal bolSilent As Boolean = False) Const strTitleConfirm As String = "تأكيد الطباعة" Const strTitleAlert As String = "تنبيه" Const strTitleError As String = "خطأ" Dim strRecordSource As String On Error GoTo ErrHandler ''---- التحقق من وجود التقرير If Not ReportExists(strReportName) Then If Not bolSilent Then MsgBox "التقرير '" & strReportName & "' غير موجود.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert End If Exit Sub End If ''---- الحصول على مصدر البيانات strRecordSource = GetRecordSource(strReportName) If Nz(strRecordSource, "") = "" Then If Not bolSilent Then MsgBox "التقرير '" & strReportName & "' لا يحتوي على مصدر بيانات.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert End If Exit Sub End If ''---- التحقق من وجود بيانات If Not ReportHasData(strReportName, strRecordSource, strWhereCondition, strOpenArgs) Then If Not bolSilent Then MsgBox "التقرير '" & strReportName & "' لا يحتوي على بيانات.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert End If Exit Sub End If ''---- طلب تأكيد الطباعة If bolAskToPrint And Not bolSilent Then If MsgBox("هل تريد طباعة التقرير '" & strReportName & "'؟", vbYesNo + vbQuestion + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleConfirm) = vbNo Then Exit Sub End If End If ''---- فتح التقرير DoCmd.OpenReport strReportName, strViewMode, , strWhereCondition, acWindowNormal, strOpenArgs CleanUp: Exit Sub ErrHandler: Select Case Err.Number Case 2501 ''---- تم إلغاء العملية Case 2212 If Not bolSilent Then MsgBox "تم إلغاء عملية الطباعة أو تعذر العثور على التقرير '" & strReportName & "'.", _ vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert End If Case Else If Not bolSilent Then MsgBox "حدث خطأ أثناء فتح التقرير '" & strReportName & "'!" & vbCrLf & _ "رقم الخطأ: " & Err.Number & vbCrLf & _ "الوصف: " & Err.Description, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleError End If End Select GoTo CleanUp End Sub وفى هذا الجزء استعرض بعض الامثلة لطرق الاستدعاء واستخدام الكود ' ====== (OpenReportSmart) طرق استدعاء الإجراء الرئيسي ====== '' 01 --- أبسط استدعاء بدون معلمات إضافية '' --- يعرض التقرير rptEmployees في الوضع الافتراضي للطباعة، مع تأكيد وظهور الرسائل Call OpenReportSmart("rptEmployees") '' 02 --- استدعاء بدون تأكيد '' --- يعرض التقرير بدون سؤال المستخدم عن التأكيد قبل الطباعة Call OpenReportSmart("rptEmployees", False) '' 03 --- فتح التقرير في وضع المعاينة Preview '' --- يفتح التقرير في وضع المعاينة، مع تأكيد قبل العرض Call OpenReportSmart("rptEmployees", True, acViewPreview) '' 04 --- تمرير شرط تصفية Where '' --- عرض التقرير فقط للموظفين في قسم معين Call OpenReportSmart("rptEmployees", True, acViewPreview, "DepartmentID = 5") '' 05 --- تمرير بيانات عبر OpenArgs '' --- يستخدم OpenArgs داخل التقرير لتخصيص العرض Call OpenReportSmart("rptEmployees", True, acViewPreview, , "ShowSummary") '' 06 --- الوضع الصامت (لا يظهر أي رسائل) '' --- يفترض صحة كل شيء، ولا يعرض أي تنبيهات للمستخدم Call OpenReportSmart("rptEmployees", , , , , True) '' 07 --- مثال كامل بجميع المعاملات '' --- عرض بالتصفية، ووسائط OpenArgs، مع تأكيد، بدون صمت Call OpenReportSmart("rptEmployees", True, acViewPreview, "IsActive = True", "FromMainMenu", False) '' 08 --- مثال طباعة تقرير بناءً على اختيار موظف من نموذج Public Sub Example5_PrintReportWithDynamicFilter() ' ' --- التحقق من تحميل نموذج اختيار الموظف If CurrentProject.AllForms("frmEmployeeSelector").IsLoaded Then Dim strFilter As String strFilter = "EmployeeID = " & Forms!frmEmployeeSelector!cboEmployeeID Call OpenReportSmart("rptEmployeeAttendance", True, acViewNormal, strFilter) Else MsgBox "يرجى فتح نموذج اختيار الموظف أولاً.", _ vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه" End If End Sub '' 09 --- معاينة تقرير ليوم محدد (تاريخ اليوم) Public Sub Example6_PreviewReportWithDateFilter() Dim strFilter As String strFilter = "ReportDate = #" & Format(Date, "mm/dd/yyyy") & "#" Call OpenReportSmart("rptDailySummary", True, acViewPreview, strFilter) End Sub '' 10 --- استدعاء التقرير باستخدام متغير شرط بتنسيقات مختلفة (نصي، رقمي، تاريخي) '' --- المثال الاساسى Call OpenReportSmart("rptEmployees", True, acViewPreview, "DepartmentID = 5") ''>>--> رقمي (رقم قسم مثلاً) Public Sub Example_NumericFilter() Dim lngDepartmentID As Long lngDepartmentID = 5 Dim strFilter As String strFilter = "DepartmentID = " & lngDepartmentID Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter) End Sub ''>>--> نصي (اسم الموظف مثلاً) Public Sub Example_TextFilter() Dim strEmployeeName As String strEmployeeName = "محمد علي" Dim strFilter As String strFilter = "EmployeeName = '" & strEmployeeName & "'" Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter) End Sub ''>>--> تاريخ (بيانات ليوم معين) Public Sub Example_DateFilter() Dim datTargetDate As Date datTargetDate = DateSerial(2025, 7, 1) Dim strFilter As String strFilter = "HireDate = #" & Format(datTargetDate, "mm/dd/yyyy") & "#" Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter) End Sub ' ======================= استخدام المعايير حسب انواع البيانات ======================= '>>--> رقمي-----Long / Integer : "FieldName = " & Numeric '>>--> نصي----String : "FieldName = '" & النص & "'" '>>--> تاريخ----Date : "FieldName = #" & Format(date, "mm/dd/yyyy") & "#" ' ===================================================================================== ولكن وجب التنويه الى شئ : الأكواد قيد التجربـــة أنا لسه كاتب الاكواد بناء على سؤال فى المنتدى

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

خزينة المشتريات والتراخيص المركزية عام 2025-2026.xlsx السلام عليكم ورحمة الله وبركاته أساتذتي الكرام الملف المرفق أحاول عمل معادلة لشيت المشتريات والتراخيص بحيث يتم تنزيل الوارد بهما من شيت الوارد ولكن المعادلة تترك بعض الخلايا فارغة بغير تتابع بالخلايا. أرجو من سيادتكم هل يمكن تحويل الخلايا الخاصة ب المشتريات والتراخيص كل في الشبت الخاص بهما مع عدم ترك فراغات. وشكرا لحضراتكم.

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

هل التصور صحيح في الصورة ................. Private Sub أمر309_Click() Dim rst As DAO.Recordset Dim db As DAO.Database Dim ctl As Control Dim controlsList As New Collection Dim dorAwalField As String, dorThanField As String, finalField As String Dim dorAwalVal As Variant, dorThanVal As Variant, finalVal As Variant Dim i As Integer Dim excludedNames As Variant Set db = CurrentDb() Set rst = Me.RecordsetClone ' نسخة من مصدر بيانات النموذج ' أسماء الحقول التي نريد استثناؤها (اسم الطالب، رقم الجلوس) excludedNames = Array("num_Glos", "name_student") ' جمع أسماء الحقول المرتبطة بالدرجات، حسب ترتيب مربعات النص في النموذج For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then If IsExcluded(ctl.Name, excludedNames) = False Then If ctl.ControlSource <> "" Then controlsList.Add ctl.ControlSource End If End If End If Next ctl ' المرور على جميع السجلات وتحديث الدرجات If Not rst.EOF Then rst.MoveFirst Do While Not rst.EOF rst.Edit For i = 1 To controlsList.Count Step 3 If i + 2 <= controlsList.Count Then dorAwalField = controlsList(i) dorThanField = controlsList(i + 1) finalField = controlsList(i + 2) dorAwalVal = Nz(rst(dorAwalField), 0) dorThanVal = rst(dorThanField) ' بدون Nz حتى نتحقق من Null ' تنفيذ القاعدة: If IsNull(dorThanVal) Then finalVal = dorAwalVal ElseIf dorThanVal = -1 Then finalVal = -1 ElseIf dorThanVal >= 50 Then finalVal = 50 Else finalVal = dorThanVal End If rst(finalField) = finalVal End If Next i rst.Update rst.MoveNext Loop rst.Close Set rst = Nothing Set db = Nothing Me.Requery ' لتحديث النموذج بعد التعديل MsgBox "تم تحديث جميع الدرجات النهائية بنجاح.", vbInformation End Sub

ماشى هنقول بسبة من 80 الى 85 % ذهب الوميض والاهتنزاز ولكن ما زال هناك مشاكل اهتزاز عند البدء واستخدام Transparent مع ال Buffering ليس علاج ما هو الا مسكنات فقط ومشكلة اختفاء العناصر حتى يتم التكبير وعمل استعادة لحجم النموذج مرة أخرى وطبعا مع الانظمة والاجهزة الدنيا سوف يكون الوضع اسوء ناهيكم عن الشبكة وهذا مثال خفيف ناهيكم عن نموذج يعتمد على احداث فى التيمر -------------- وهذا ما يثيت قولى اكسس ليس مصمم ليكون بيئة رسوميات عالية الأداء نماذج اكسس ليست مهيأة لتحديثات واجهة المستخدم السريعة مثل Windows Forms لذلك سوف تبقى هذه مشكلة أزلية الوميض (Flickering) والارتعاش (Shaking or Jittering) والاكسس اصدقاء لن يتخلى احدهم عن الاخر