ابوخليل

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

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

الكود في مشاركتي الاخيرة وافي وكافي ... فقط تضاف هذه الجملة عند اغلاق البرنامج لمن اراد حذف الملف FilePath = CurrentProject.Path & "\" & "soccer.png" Result = Dir(FilePath) If Result <> "" Then Kill FilePath End if وهذا يعني انك لم تفهم عني ما اريد راجع نقاشي مع اخونا فادي

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

كل الطرق اعلاه واحدة طريقتك كل فتح لاي نموذج اذا النماذج تحمل ايقونات في الاطار .. كل فتح يتم حذف الصورة ثم ارسالها مرة اخرى لو لم تفعل ذلك لا يمكنك الارسال مرة اخرى اقصد تشغيل الدالة سترجع بخطأ وجود الملف انا عالجت هذه المشكلة .. جعلت الارسال يتم مرة واحدة عند اقلاع البرنامج .. والبرنامج بكل مكوناته سيرتبط بالصورة مباشرة ولا حاجة للارسال Function RelinkIsIco() As String Dim rs As DAO.Recordset Dim rst As DAO.Recordset2 Dim FilePath As String Dim strFilePath As String Dim Result As String FilePath = CurrentProject.Path & "\" & "soccer.png" Result = Dir(FilePath) If Result <> "" Then RelinkIsIco = FilePath Exit Function Else Set rs = CurrentDb.OpenRecordset("tblEnDc") Set rst = rs.Fields("progIcon").Value strFilePath = CurrentProject.Path & "\" & rst.Fields("FileName").Value rst.Fields("FileData").SaveToFile strFilePath RelinkIsIco = strFilePath End If rst.Close Set rst = Nothing rs.Close Set rs = Nothing End Function ولكن هذا لا يكفي حاجتي او هدفي الى نوع من انواع الحماية الخاصة ليس بالضرورة ان يكون صورة

صباح الفل اخي فادي الغاية هي الوصول الى الهدف لا تتهرب .. سوف امهلك الى ما بعد الافطار

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

وجدت حلا وهي الطريقة الوحيدة التي وصلت اليها وهي نسخ الصورة وارسالها بجانب قاعدة البيانات نعم هي طريقة مفيدة ... ففي هذا الوضع لا يعتمد البرنامج على صور خارجية .. وحتى لو تم حذفها او العبث في التسمية فسوف يدرج اكسس صورة جديدة ورغم ان الارسال سيتم مرة واحدة عند اقلاع البرنامج .. الا انه عند فتح النماذج كل نموذج يتم فتحه تتم عملية حذف الصورة الموجودة وارسال صورة جديدة ويمكنني تلافي ذلك بجعل الكود يتفحص اذا الصورة موجودة بجانب قاعدة البيانات ام لا .. فإذا موجودة يأخذ من موقع الصورة مباشرة وان لم يجدها يرسل جديدة . وغالبا ستكون موجودة بجوار قاعدة البيانات . سأعرض لكم الكود الذي تمت معالجته + المرفق Function RelinkIsIco() As String Dim rs As DAO.Recordset Dim rst As DAO.Recordset Dim strFilePath As String Set rs = CurrentDb.OpenRecordset("tblEnDc") Set rst = rs.Fields("progIcon").Value strFilePath = CurrentProject.Path & "\" & rst.Fields("FileName").Value Kill strFilePath rst.Fields("FileData").SaveToFile strFilePath rst.Close : Set rst = Nothing rs.Close : Set rs = Nothing RelinkIsIco = strFilePath End Function Private Sub cmdShar_Click() Me.img1.Picture = RelinkIsIco End Sub ولكني اطمح الى عمل افضل من ذلك وهنا يأتي السؤال : هل يمكن عمل متغير يحمل رابطا أو مسارا وهميا بدلا من المسار الصريح ؟ أو متغيرين .. واحد يحمل رابط وهمي والآخر يحمل اسم الملف ؟ Database2.rar

يا هلا اخوي محمد تغيب وتعود سالما غانما هي وحيدة يتيمة

صحيح 100% يجب التعامل كـــ Fields("FileData") ولكني نسيتها

السلام عليكم قمت بحفظ ايقونة في حقل مرفقات (Attachment) في جدول من اجل استخدامها في اماكن متعددة في البرنامج ذهبت الى هذا النهج من اجل تبقى الايقونة غير ظاهرة .. بحيث لا يمكن حذفها او التعديل عليها واستخدمت هذا الكود لكنه لم يعمل Function RelinkIsIco() As String Dim rs As DAO.Recordset Dim ImagePath As String Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblEnDc") ImagePath = rs!progIcon.Value RelinkIsIco = ImagePath rs.Close Set rs = Nothing End Function Private Sub cmdShar_Click() Me.img1.Picture = RelinkIsIco() End Sub آمل التصحيح ادناه مثال للتجربة Database1.rar

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

اجدت وأفدت مع ان ما قدمه اخونا Debug Ace رائع لا يقاوم .. لوجود ميزات متقدمة الا انني يبدو سأعتمد نسختك هذه لعدة اسباب : - تحقق عرض الخطوط العربية فقط من وندوز - التعامل مع التقرير مباشرة وحفظ آخر نسخة لتصبح دائمة - جلب الخلفية مفتوح وغير مقيد كل هذه قريبة من عملي تقريبا .. مع بعض التعديلات اللازمة جزاكم الله خيرا .. جميعا واجزل لكم الثواب

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

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

بارك الله فيك .. اجدت وأفدت المهم هو توقيع فوكش .. جميلة هذه التوقيعات .. تذكرنا ببعض في محفوظاتي اعمال كثيرة استفيد منها عند الحاجة فابحث عنها واوظفها غالب هذه الاعمال لإخوة لنا هنا .. ولكن لا يوجد عليها علامات تذكرنا بهم .. اقل حق من حقوقهم ان ندعو لهم في ظهر الغيب

الله .. الله .. الله .. ما هذا !! لا يهمني العمل الآن .. يكفيني النص المكتوب .. اخجلتني يارجل .. لحظة تعال ... معرف جديد + خبرة فائقة .. وخطاب يمثل المنتدى .. اني لأشم ريح يوسف

نسيت كلمات المرور للدخول عام = 1 مدير= 2

تمام اليك المرفق النهائي بعد معالجة ثغرة توقيع الانصراف من الغد آمل ان تجري التحسينات المقترحة .. دمت ذخرا لاخوانك ومحبيك ChkInOut_CNet2.rar

نعم الثغرة موجودة .. يجب معالجتها لذا حذفت المرفق .. من اجل التعديل والاصلاح

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

نعم .. تماما السر في هذه الدالة التي حلت المشكلة الدالة تتحدث وليست بحاجة الى شرح .. حيث تفحص الوقت الحالي هل هو في مساء اليوم ام لا Dim startTime As Date Dim endTime As Date Dim currentTime As Date Dim i As Integer startTime = TimeValue("12:01:00") endTime = TimeValue("23:59:59") currentTime = Time() If currentTime > startTime And currentTime < endTime Then i = 1 Else i = 2 End If CheckTimeBetween = i وكان السبب الرئيس في المشكلة هو دالة توقيت المساء سواء الحضور او الانصراف لأنه عند دخول اليوم التالي يعتبر الدخول المسائي ضمن مساء الغد لهذا تم تعديل دالتي التوقيت المسائي وفقا لهذه الدالة اعلاه انظروا كيف تتعامل الدالتان ادناه الشرط يقول : اذا الوقت الحالي داخل في شرط الدالة وصحيح .. اي =1 فالتاريخ تاريخ اليوم وإلا فإن التاريخ هو تاريخ الأمس Public Function funFirstTimeB_in() Dim z As Integer Dim i As Date, ii As Date, jj As Date z = Nz(DLookup("free2_in", "tblTimeCtrl"), 0) If CheckTimeBetween() = 1 Then i = DLookup("fatrah2_In", "tblTimeCtrl") & " " & Date ii = DateAdd("n", -z, i) Else jj = DateAdd("d", -1, Date) i = DLookup("fatrah2_In", "tblTimeCtrl") & " " & jj ii = DateAdd("n", -z, i) End If funFirstTimeB_in = ii End Function Public Function funLastTimeB_Out() Dim z As Integer Dim x As Integer, xx As Integer Dim i As Date, ii As Date, jj As Date z = Nz(DLookup("free2_out", "tblTimeCtrl"), 0) x = Nz(DLookup("hours_Work2", "tblTimeCtrl"), 0) xx = (x * 60) + z If CheckTimeBetween() = 1 Then i = DLookup("fatrah2_In", "tblTimeCtrl") & " " & Date ii = DateAdd("n", xx, i) Else jj = DateAdd("d", -1, Date) i = DLookup("fatrah2_In", "tblTimeCtrl") & " " & jj ii = DateAdd("n", xx, i) End If funLastTimeB_Out = ii End Function للتجربة والتأكد ان كل شيء تمام جعلت عند التوقيع في الفترتين كليهما .. تظهر رسالتان الاولى لبداية التوقيع والثانية لنهايته اذا الامور تمام يمكنك تعطيل وايقاف هذه الرسائل بداية التوقيع = وقت الدخول الرسمي - الوقت المتاح قبل نهاية التوقيع = وقت الدخول الرسمي + عدد ساعات العمل + الوقت المتاح بعد جعلت الاوقات المتاحة بالدقائق من اجل دقة الاختيار

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

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

بل اعجبني المشهد .. سلمت اناملك يا سلام .. زاد حماسي .. احب المفاجآت في مثل هذه المواضيع