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

السلام عليكم 🙂 اخوي ابو خليل ، هناك ملاحظة عن تشفيرك في اول مشاركة ، فلما يفتح البرنامج الصورة ، فتظهر بألوان تختلف عن الصورة الاصليه (مع العلم ان الصورة المحفوظه بعد التشفير الوانها صحيحة!!). ***** وهنا ملاحظات هامة : بعض البرامج مثل الاكسل لا تنفتح بعد اعادة التشفير. عند ارفاق الملف ، والذي يقوم الكود بتشفيره ، فإذا ذهبث للمجلد الذي فيه الصورة المشفرة ، ثم اردت فتح الصورة ، فستجد رسالة خطأ من الوندوز بأنه لا يمكن فتح الملف ، وهو المطلوب ، الآن افتح الملف عن طريق النقر على اسم الملف من البرنامج ، فسينفتح الملف ، ورجاء غلق الملف ، الآن اذهب الى الخطوة رقم 2 اعلاه ، فالمفاجأة بأنه يمكنك فتح الملف مباشرة من المجلد !! والسبب بأننا قمنا بفك تشفير الملف عن طريق الخطوة رقم 2 !! الطريقة الصحيحة للتعامل مع الملف ، هو اخذ نسخة من الملف الى مجلد آخر ، فك التشفير ، ثم افتح الملف. يعني فك التشفير يكون للملف المؤقت دون المساس بالملف الاصل ، هذا الكود في النموذج الفرعي يقوم بالعمل اعلاه : Private Sub name_morfke_Click() Dim Source_File_Path As String, Destination_File_Path As String Source_File_Path = CurrentProject.Path & "\" & Me.name_morfke Destination_File_Path = Environ("Temp") & "\" & Me.name_morfke FileCopy Source_File_Path, Destination_File_Path Application.FollowHyperlink (Destination_File_Path) EcryptDcryptImage (Destination_File_Path) End Sub Private Sub Form_Close() On Error Resume Next Dim Srst As DAO.Recordset Set Srst = Me.RecordsetClone Do Until Srst.EOF Kill Environ("Temp") & "\" & Srst!name_morfke Srst.MoveNext Loop End Sub جعفر

تفضل <><><><><><><> Numberic.accdb

هذه العبارة غير واضحة عموما تستطيع أن تستخدم دالة Replace لإزالة أصفار الوقت سأكتب لك المعادلة من حفظي كالآتي: myDate = Replace(myDate," 00:00:00","")

وعليكم السلام ورحمة الله وبركاته أخي حسين 🙂 تفضل الحل : وهذا أمر الترقيم ( في حال لم تضع الرقم ، سيبدأ تلقائيا من الرقم 1 ) : Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim x As Double x = Nz(StartNumTxt.Value, 1) Set dbs = CurrentDb Set rst = dbs.OpenRecordset("tabol_1") ' بين القوسين اسم الجدول/ الاستعلام أو جملة السيكول rst.MoveLast rst.MoveFirst Do Until rst.EOF rst.Edit rst!id_1 = x rst.Update rst.MoveNext x = x + 1 Loop Me.Requery rst.Close Set dbs = Nothing Set rst = Nothing ترقيم تلقائي يبدأ من رقم محدد.rar

طيب استبدل بهذا ...... Public Function CountNumberic() As Integer Dim StringToSearch As String, ms As Integer, ms1 As Integer Dim i As Integer If Len(Me.Text4) <= 1 Or IsNull(Me.Text4) Then StringToSearch = Me.Text1 Else StringToSearch = Me.Text4 End If ms = 0 ms1 = 0 For i = 1 To Len(StringToSearch) ms = Mid(StringToSearch, i, 1) ms1 = ms1 + ms Next i Me.Text4 = ms1 End Function

السلام عليكم مرفق لك الملف السجــــــــــل.xlsx

السبب هو كبر حجم الملفات حيث تم اعداد الكود للتعامل مع الملفات والصور التي احجامها بالكيلوبايت ، فلا باس هنا ان يتعامل مع كامل حجم الملف اما اذا كانت الملفات كبيرة فيلزم تطبيق التشفير على جزء من الملف تجد ادناه انه تم تعديل الكود ليتناسب مع اي حجم حيث يتم التطبيق على جزء من الملف ، حسب ما يقتضيه الحال لاحظ الرقم 5 فهو بيت القصيد ايضا لاحظ اني جعلت وظيفته عامه ليتم مناداته من اي مكان في البرنامج لذا اجعله في وحدة نمطية عامة Public Function EcryptDcryptImage(sFileSpec As String) Dim iFle As Long Dim iByteCount As Long Dim i As Long Dim ii As Byte iFle = FreeFile Open sFileSpec For Binary As iFle iByteCount = LOF(iFle) For i = 1 To Mid(iByteCount, 5) Get iFle, i, ii ii = ii Xor &HFF Put iFle, i, ii Next i Close iFle End Function

تم تطبيق الكود السابق على المرفق كالأتي تم انشاء مودول واضافة الكود Public Sub EcryptDcryptImage(sFileSpec As String) Dim iFle As Long Dim iByteCount As Long Dim i As Long Dim ii As Byte iFle = FreeFile Open sFileSpec For Binary As iFle iByteCount = LOF(iFle) For i = 1 To iByteCount Get iFle, i, ii ii = ii Xor &HFF Put iFle, i, ii Next i Close iFle If UCase$(Right$(sFileSpec, 1)) = "." Then Name sFileSpec As Left$(sFileSpec, Len(sFileSpec) - 1) Else Name sFileSpec As sFileSpec & "." End If End Sub بعد ذلك تم وضع الكود التالي تحت زر امر ادراج مرفقات EcryptDcryptImage ([CurrentProject].[Path] & "\image1" & ".jpg") وتم ايضا اضافته في في حدث عند النقر على مسار الصورة (اسم المرفق) عند التطبيق لوحظ الأتي : عند ادراج صوره او عدة صور او مرفقات اخرى (وورد - اكسل - pdf- فيديو) تنضاف للبرنامج ويتم تشفيرها لكن تاخذ وقت من في الدوران من دقيقة الى 5 دقائق واكثر وكذلك تاخذ وقت عند فتح التشفير من خلال النقر على مسار المرفق واحياناً ويستمر بالدوران ولايتم التوقف الا اذا قمت بعمل (ctrl+break) ارجوا تفضلكم بالاطلاع على المرفق والمأخوذ من مشاركة للأخ العزيز @محمد سلامة والمعلم @jjafferr وقد استفدت منه في برنامجي وتبقىت هذه الجزئية عسى ان تجدوا حل لها اسئل الله ان ينفعنا بعلمكم ويجزيكم عنا خير الجزاء بالدنيا والاخرة test.accdb

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

شكرا استاذي الغالي على المداخلة وفكرتك جميلة للحفاظ على الصورة الأصل محمية ما رأيك لو يتم عكس العملية ( اقصد التشفير بعد الفتح ) عند حدث الخروج من حقل اسم الملف ؟

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

وعليكم السلام هي فعلا موجودة في جدول طالما انك ادخلتها بالفعل ..... انظر ....

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

والعذر منك أخي @biskra لم أر ردك إلا لاحقا 🙂🌹

جرب الكود التالي فقط عدل في مسار ملف الحفظ لأنه لا يمكنك فتح التقرير بامتداد pdf دون ان تتم عملية التصدير الى صيغة pdf أولا و إذا نجحت معك عدل على الكود بالنسبة لبقية السؤال DoCmd.OpenReport "t1", acViewPreview DoCmd.OutputTo acOutputReport, "t1", acFormatPDF, "مسار ملف الحفظ", True

بالإضافة إلى ما قاله أخي محمد البرناوي 🙂 ضع هذه الإعدادات للتقرير : ثم ضع هذين السطرين عند الفتح : DoCmd.Maximize DoCmd.Restore جرب الآن فتح التقرير .. سيظهر عندك بهذه الصورة : قم بتغيير حجمه بالطريقة التي تريده أن يظهر بها .. ثم اضغط على ( Ctrl + S ) من الكيبورد ( أي حفظ الوضعية التي عليها الآن : بعدها سوف يظهر لك التقرير دائما بهذه الصورة 🙂☝

هذا الموضوع مميز ويستحق التثبيت ××××××× مثبت ××××××× الإدارة

افتح النموذج الفرعي سداد على التصميم افتح الخصائص / لسان التبويب : بيانات غير الخاصية : ادخال بيانات من (لا) الى (نعم) ... واحفظ

السلام عليكم خى الفاضل / هذا الملف لأحد الزملاء افتحه قد يفى بالغرض منع فتح الملف إذا تم نقله أو تغيير إسمه ومنع حفظه بإسم جديد.

الحمد لله تم حل الاشكالية بعد خذف الواتس اب واعادة تنصيبة من جديد

ابشر تم .. 😘 مقارنة.xls

حدث المتصفح يمكن قديم تاكد انه 10او11

نتائج البحث عن "شجرة" في منتدى الأكسس Searched for 'شجرة' in موضوعات (officena.net)

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

هذا الموضوع مهم بالنسبة للمحاسبين ...وبما اني لست محاسبا ومع الاسف فلم اهتم لهذا الموضوع كثيرا انظر هذا الفيديو للاستاذ مؤمن سالم ...واعتقد انه احد اعضاء منتدانا العزيز

اخي الكريم ... لا تزعل من مناقشتي لك ... فقط ليطمأن قلبي ... والامر متروك لاحد المشرفين ان اذن فأبشر بالباس ننتظر السيد @jjafferr او السيد @أبو إبراهيم الغامدي اعطوني رأيكم حتى لا نخالف قوانين المنتدى

وعليكم السلام ورحمة الله وبركاته اخى @أبوعيد يوجد موضوع هنا في المنتدى يتحدث عن طلبك هنا وهنا رابط خارجي وايضا هذا الفيديو لعله يفيدك

وعليكم السلام ورحمة الله وبركاته هذه الوظيفة تشفر الصورة بنقرة ، وبالنقرة الثانية تفك التشفير يمكنك ادراجها عند جلب الصور وكذلك عند عرضها المهم ان تضعها في مكانها المناسب Private Sub zer1_Click() EcryptDcryptImage ([CurrentProject].[Path] & "\image1" & ".jpg") End Sub Public Sub EcryptDcryptImage(sFileSpec As String) Dim iFle As Long Dim iByteCount As Long Dim i As Long Dim ii As Byte iFle = FreeFile Open sFileSpec For Binary As iFle iByteCount = LOF(iFle) For i = 1 To iByteCount Get iFle, i, ii ii = ii Xor &HFF Put iFle, i, ii Next i Close iFle If UCase$(Right$(sFileSpec, 1)) = "." Then Name sFileSpec As Left$(sFileSpec, Len(sFileSpec) - 1) Else Name sFileSpec As sFileSpec & "." End If End Sub

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

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

تفضل اخي Workbook ضع هدا الكود في حدث Private Sub Workbook_Open() Application.OnTime Now + TimeValue("00:00:15"), "SAVE_MH" Call SAVE_MH End Sub Module وهدا في Sub Save_MH() Application.DisplayAlerts = False Application.OnTime Now + TimeValue("00:00:15"), "SAVE_MH" ActiveWorkbook.SaveCopyAs Filename:="c:\Backups\" & ActiveWorkbook.Name ActiveWorkbook.Save Application.DisplayAlerts = True End Sub Sub Save2_MH() Application.DisplayAlerts = False ThisWorkbook.Save Application.DisplayAlerts = True Application.OnTime Now + TimeValue("00:00:15"), "Save2_MH" End Sub قد تمت اضافة الكود للملف للتجربة في حالة كانت عندك رغبة بالاحتفاظ بجميع النسخ رغم انني ارى انك في غنى عنها يمكنك جعل الكود بهده الطريقة و تجعلها كل 10 دقائق مثلا Workbook ضع هدا الكود في حدث Private Sub Workbook_Open() Application.OnTime Now + TimeValue("00:10:00"), "save_MH3" 'Application.OnTime Now + TimeValue("00:00:15"), "save_MH3" Call save_MH3 End Sub ---------Module وهدا في---------- Sub save_MH3() Dim MyDate MyDate = Date Dim MyTime MyTime = Time Dim TestStr As String 'تاريخ اليوم TestStr = Format(MyTime, "hh-mm-ss") Dim Test1Str As String 'ساعة الحفظ Test1Str = Format(MyDate, "DD-MM-YYYY") Application.DisplayAlerts = False 'Application.OnTime Now + TimeValue("00:00:15"), "save_MH3" Application.OnTime Now + TimeValue("00:10:00"), "save_MH3" 'تحديد مسار حفظ الملف ActiveWorkbook.SaveCopyAs Filename:="c:\Backups\" & Test1Str & ". " & TestStr & " " & ActiveWorkbook.Name ActiveWorkbook.Save Application.DisplayAlerts = True End Sub Sub Save2_MH() Application.DisplayAlerts = False ThisWorkbook.Save Application.DisplayAlerts = True Application.OnTime Now + TimeValue("00:00:15"), "Save2_MH" End Sub تجريبى-حفظ نسخة من الملف كل 10 دقائق.xlsm تجريبي.xlsm

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

قم بانشاء قاعدة بيانات فاضية ثم استورد الجداول من القاعدة الاولى وبقية الكائنات (طبعا بدون الجداول) من القاعدة الثانية