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

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته اليوم جئتكم بفكرة جديدة وإبداعية لتحديث نسخة الواجهات FE لدى المستخدمين بدون الاستعانة بملفات وبرامج خارجية 🙂 وذلك بالاستعانة بملفي الواجهات FE وملف قاعدة البيانات ( الجداول ) BE فقط 😊 وقد قمت بشرح الفكرة ومحاولة تبسيطها قدر الإمكان من خلال الشرح الآتي مستعيناً بالله وتوفيقه .. :: أصل المشكلة :: أولاً : من المعلوم أنه يفضل أن يكون البرنامج مقسم إلى ملفين ( الواجهات FE - وقاعدة الجداول BE ) وذلك لكي يعمل عليه أكثر من مستخدم. FE: هي اختصار لـ Front End النهاية الأمامية .. أي ملف الواجهات و BE: هي اختصار لـ Back End النهاية الخلفية .. وهو ملف الجداول ملف الـ BE غالبا ما يكون مخزن في السيرفر بطريقة يمكن لجميع المستخدمين من الوصول إليه حيث أن البيانات جميعها يتم تخزينها فيه. ويتم توزيع ملفات الـ( FE) على أجهزة المستخدمين ، وهي محور حديثنا لهذا اليوم الرائع الجميل .. 😊 مختصر الكلام : أنه كثيرا ما يعاني مصممو البرامج من إعادة توزيع ملفات الواجهات ( FE ) على أجهزة المستخدمين عندما تكون هناك تحديثات جديدة على البرنامج أو معالجة لأخطاء في البرنامج ... الطريقة والفكرة التي سنتحدث عنها اليوم تقوم بحل هذه المعاناة وجعل البرنامج يقوم بتوزيع الـ (FE) نيابة عنك أوتوماتيكيا وبدون أي جهد يطلب من المستخدمين .. 😉 :: شرح الفكرة وآلية العمل :: الفكرة التي سأطرحها قائمة على الاتصال بملف الجداول الـ (BE) والاستعانة به ليقوم بتوزيع ملف التحديث الجديد على أجهزة المستخدمين بعد أن يستبدل القديم بالجديد .. حيث أننا سنحتاج إلى : 1 - جدول في قاعدة الـ (BE) ومتصل بنسخة الـ (FE) كذلك، لتخزين روابط مواقع كل ملف ( FE - BE - New Update ). 2- ماكرو Autoexec وضيفته تشغيل الكود الذي سيفحص وجود تحديثات جديدة من عدمه عند بدء تشغيل البرنامج ، ويوضع في نسخة الـ (FE). 3- سنحتاج لإضافة نموذج في نسخة الجداول الـ (BE) مهمته تشغيل الكود الذي سيحدث نسخة الـ (FE). والكود يعمل عند حدث (عند التشغيل - ON OPEN ). 4- سنحتاج لجدول (محلي) يبقى في نسخة الواجهات الـ (FE) فيه حقل تاريخ عبارة عن سجل واحد يكتب فيه تاريخ الإصدار للنسخة الحالية. وهذا شرح مصور مبسط لآلية العمل : الصورة (1) : محتويات الملفات الأساسية المستخدمة في العمل. الصورة (2) : المرحلة الأولى : فحص وجوود تحديثات جديدة من خلال ملف الواجهات FE الصورة (3) : رسالة تأكيد للبدء في التحديث الصورة (4) : الخطوة الثالثة : إغلاق ال(FE) وفتح ال(BE) الصورة (5) : إستبدال النسخة القديمة بالجديدة وإعادة تشغيل البرنامج 🙂 هذا كل شيء ببساطة 😅🖐️ :: الأكواد المستخدمة :: أولاً : الكود المستخدم في ملف الواجهات الـ (FE) : Public Sub UpdateUsersFE(CurrentVerDate As Date, NewVerDate As Date, _ txtOldFEPath As String, txtNewFEPath As String, _ txtBEPath As String, txtBEUpdateForm As String, _ DoTheUpdaet As Boolean) On Error Resume Next ' ************************************************** Check If the Manager Send The Update Order If DoTheUpdaet = True Then ' Continue The Code Else MsgBox "لا يوجد تحديث جديد" Exit Sub End If ' ************************************************** Check Version Date If CurrentVerDate < NewVerDate Then ' Continue The Code ' MsgBox "سوف يتم التحديث إن شاء الله" ' Exit Sub Else ' MsgBox "لديك آخر إصدار" Exit Sub End If ' *************************************************** Confermation Msg. If MsgBox("لديك تحديث جديد للبرنامج، متابعة؟", vbYesNo, "Apply New Update?") = vbYes Then Else: Exit Sub End If ' ************************************************** Open the BE and the Update Form Dim objAdb As Object Set objAdb = CreateObject("Access.Application") objAdb.OpenCurrentDatabase (txtBEPath) objAdb.DoCmd.OpenForm txtBEUpdateForm objAdb.Visible = False ' ************************************************** Close FE Database DoCmd.Quit Set objAdb = Nothing End Sub Public Function testUpdate() Dim BackEndPath As String, FrontEndPath As String, UpdatePath As String, CurrentVerDate As Date, NewVerDate As Date, StartUpdating As Boolean CurrentVerDate = DFirst("[VersionDate]", "[FE_Tbl_Version]") NewVerDate = DFirst("[LastUpdateDate]", "[BE_Tbl_Updates]") BackEndPath = DFirst("[BackEndPath]", "[BE_Tbl_Updates]") FrontEndPath = DFirst("[FrontEndPath]", "[BE_Tbl_Updates]") UpdatePath = DFirst("[UpdatePath]", "[BE_Tbl_Updates]") StartUpdating = DFirst("[StartUpdating]", "[BE_Tbl_Updates]") Call UpdateUsersFE(CurrentVerDate, NewVerDate, FrontEndPath, UpdatePath, BackEndPath, "BE_Frm_StartUpdating", StartUpdating) End Function ثانياً : الكود المستخدم في ملف الجداول الـ (BE) : #If VBA7 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #Else Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If Private Sub Form_Open(Cancel As Integer) Call UpdateFE End Sub Public Sub UpdateFE() Dim FrontEndPath As String, NewUpdatePath As String FrontEndPath = DFirst("[FrontEndPath]", "[BE_Tbl_Updates]") NewUpdatePath = DFirst("[UpdatePath]", "[BE_Tbl_Updates]") 'On Error Resume Next '********************************************************************(Waite for 3 seconds until FE Closed ) Sleep 3000 '********************************************************************(Copy the New Update to the User PC) Dim fs As Object Set fs = CreateObject("Scripting.FileSystemObject") 'Kill FrontEndPath 'Sleep 1000 fs.CopyFile NewUpdatePath, FrontEndPath, True '********************************************************************(Open the new FE for the user) 'Sleep 1000 Dim objAdb As Object Set objAdb = CreateObject("Access.Application") objAdb.OpenCurrentDatabase (FrontEndPath) objAdb.Visible = True objAdb.DoCmd.RunCommand acCmdAppMaximize '*********************************************************************(Close BE) DoCmd.Quit Set objAdb = Nothing End Sub :: (مهم جدا ) قبل التجربة والتطبيق :: ستجدون في المرفقات ثلاثة ملفات: - ملف الواجهات القديم (FE-MyApplication) - ملف الجداول (BE-MyApplicationDatabase) -وملف الواجهات المحدث (FE-NewUpdateV2.0) أولاً : يجب إعادة ربط ملفي الواجهات (القديم + التحديث ) بملف الجداول (يدوياً ) .. وهي خطوة مهمة للعمل .. ( يمكنك عملها أوتوماتيكيا بالأكواد في برنامجك لاحقاً ، لم أشأ تعقيد الأمور هنا 😅) ثانياً : يجب عليك تحديث روابط أماكن الملفات الثلاثة في جدول (BE_Tbl_Updates) وذلك من خلال النموذج (FE_Frm_UpdateInfo) الموجود في نسخة الواجهات. والآن يمكنك الانطلاق والبدء في تجربة البرنامج 😉👊 قم بتشغيل البرنامج FE-MyApplication وانتظر لترى النتيجة 😊👌 ملاحظة : لإعادة التجربة مرة أخرى بعد التحديث ، قم بتأخير تاريخ النسخة الأمامية من جدول (FE_Tbl_Version) إلى تاريخ سابق للتاريخ المخزن في قاعدة البيانات . *************************************************************** هذا كل شيء ولا تنسوا أن تنوروني بآرائكم ومقترحاتكم ولا تنسوني من صالح دعواتكم 😊 :: التحميل :: FrontEnd Updator V1.0.rar

مشاركة مع الاستاذ خالد .... بارك الله فيه .... غير قناع الادخال في النموذج لمربع نص التاريخ الى هذا .... 00/00/"20"00

بسم الله والصلاة والسلام على رسول الله وعلى آله وصحبه ومن والاه ...إخوتي الكرام السلام عليكم ورحمة الله وبركاته أحببت أن أعرض عليكم بعض إمكانيات الإكسيل الرائعة في تنسيق الأشكال في حال عدم توفّر الفوتوشوب أو البرامج الرسومية الأخرى ليظهر الملف بشكل أنيق ... حبث أنه يتمتع بجماليات في الخط والشكل وتناسق الألوان لكنه بعود على الملف بشيءٍ من البطء وزيادة حجم الملف .. الارتباطات التشعبية تظهر على شكل شفاف كقطرات الندى في صباح ربيعي مزهر..عند وضع المؤشر عليها تدلك على الورقة الهدف. راجياً من الله تعالى أن ينال إعجاب حضراتكم. اسم المستخدم :admin كلمة السر 123 ...بعض أوراق العمل محمية دون كلمة مرور ... والسلام عليكم ورحمة الله وبركاته. مكابس بلوك.rar

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

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

تفضل هل هذا ما تريد Database1.rar

يمكنك وضع هذه المعادلة في الخلية A6 ثم سحب المعادلة لأسفل =IFERROR(INDEX('date out'!B$1:I$100,SMALL(IF('date out'!$A$1:$A$100=$A$1,ROW('date out'!$A$1:$A$100)),ROW()-5),{1,2,3,4,5,6,7,8}),"") وهذا ملفك إن كنت لا تعلم كيف تضيف المعادلة مثل بعض الأعضاء بالتوفيق Copy of BİLDİRİM LİSTESİ.xlsx

انت الاجمل باثراء الموضوع .... فشكرا لك ...

طيب ::::: اولا تخلص من العمليات الحسابية التي دونتها في مربعي النص Earning و Tak_Amnt حسب الصور المرفقة ثانيا : في مربع النص Perst وفي حدث بعد التحديث كما في الصورة ... ضع هذا الكود وجرب .... Me.Earning = [Com_Amnt] * [Perst] Me.Tak_Amnt = Val([Com_Amnt]) + Val([Earning]) Me.Requery واعلمنا بالنتيجة .....

اعرض الملف 📟 آلة حاسبة 📟 - هدية مميزة مفتوحة المصدر 🎁 السلام عليكم ورحمة الله وبركاته يطيب لي أن أقدم لكم هذا العمل البسيط وهو عبارة عن 🙂 :: آلة حاسبة :: أهديكموها مفتوحة المصدر 😊🎁 ومن مميزاتها : تم إضافة خاصية الحساب عن طريق مفاتيح الكيبورد 😊 ولا تنسونا من صالح دعواتكم 🙂 صاحب الملف Moosak تمت الاضافه 06 يون, 2022 الاقسام قسم الأكسيس  

😅😅😅😂😂 منك السموحة الغالي 😅✋🏻 لها محل ونص ، ووقرت في صميم القلب بعد 😅 بس القصد إيصال المعلومة بشكل صحيح للمتلقي .. خصوصا اللي ما بيقرأ الردود .. أفكر في المستقبل البعيد 😁..

وابويا انا عليك موسى ، تو ملاحظتي صارت لا محل لها من الاعراب 🤔🙄 🙂 جعفر

خلاص غيرتها علشان نكون في السليم وعدم الإخلال بالأمن العام 😂

أهلا أهلا أهلا بكبير المعلمين وحامل المسك 😊 زين بخرت المكان قبل لا نروح فيها 😂 أشكرك على المرور والتعليق أستاذنا @jjafferr الحقيقة وأنا أنشيء هذا الموضوع وأعمل البرنامج والتجارب عليه وأعالج الأخطاء اللي ظهرت لي ، دارت في بالي الكثير من الأفكار والمقترحات اللي يمكن تطبيقها على نفس الفكرة ، ومنها ضمنها تشغيل وحدة نمطية في ال BE بدل الفورم ( مثل ما ذكرت ) ولكن رأيت أن الفورم أسهل حتى في استدعاء البيانات من الجدول ، وفي النهاية الفكرة فيها إضافة كائنات أخرى غير الجداول في قاعدة البيانات ( موديول ، ماكرو ، .... الخ ) . وكذلك دمجها مع الكثير من الأفكار اللي تم طرحها سابقا في المنتدى مثل ( إعادة الإتصال التلقائي ) ، و ( إنشاء إختصار وأيكونة في سطح المكتب ) ، وووو وغيرها .. فقررت أخلي المجال مفتوح لإبداعات الشباب أنت الآن نورتني لفكرة الحصول على مكان الFE مباشرة قبل التحديث واستخدامه للتبديل ، فكرة عبقرية ولكن ما خطرت في بالي لأن الوضع معي في العمل هو أنني أنصب ال FE بنفسي للمستخدمين وما أخليهم يعبثو بموقعه لأنهم لو تورطوا وما عرفو يربطوه بال BE بيرجعولي في النهاية 😁 لحد الحين النقطتين 1 و 2 الحمدلله ما صارت معي ، الشبكة أمورها طيبة .. بالنسبة للنقطة هذي طبعا العمل كله على المبرمج ، فقط الرسالة اللي تطلع أول شي أنا مقرر ألغيها تماما في برامجي ، فقط وضعتها هنا على سبيل التجربة علشان أحس أن الكود شغال 😅 ، وإلا فالمستخدم ما بيحس أصلا بأنه تغير شي ، كله بالصامت . وبإذن الله ممكن أطور الكود ليأخذ عنوان ال FE لكل مستخدم على حده . هو يصلح .. بس تضل الطريقة اللي ذكرتها تحمل في طياتها البلاوي 😅🖐🏼️

بارك الله فيك أخي موسى وفي ميزان حسناتك يارب.. رب يجزيك الجنه

و عليكم السلام و رحمة الله و بركاته اخي الكريم ابو الحسن مرفق مثال لما طلبت : في حال كان جهازك متصل بالانترنت يعمل زر الاغلاق و في حال عدم الاتصال لا يعمل الزر و تظهر لك رسالة تفيد بذلك ارجو ان يكون هو المطلوب بالتوفيق internet Check.rar

لعلك تريد ربط موضوعك بهذا الموضوع : 🙂 إذا كان كذلك .. فالجواب : لا ، ليست هناك حاجة لربط جدول الإصدار ببقية الجداول . 🙂

تفضل أخي هذه أهم أوامر التعامل والتنقل بين السجلات والتعامل مع التقارير .. 🙂 خذ منها ما تريده .. وادمج الأوامر التي تريدها في زر واحد : أولا حذف السجل Private Sub DeleteBtn_Click() On Error GoTo Err_DeleteBtn_Click DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdDeleteRecord Exit_DeleteBtn_Click: Exit Sub Err_DeleteBtn_Click: MsgBox Err.Description Resume Exit_DeleteBtn_Click End Sub إضافة سجل جديد Private Sub AddNewBtn_Click() On Error GoTo Err_AddNewBtn_Click DoCmd.GoToRecord , , acNewRec Exit_AddNewBtn_Click: Exit Sub Err_AddNewBtn_Click: MsgBox Err.Description Resume Exit_AddNewBtn_Click End Sub السجل التالي Private Sub NextBtn_Click() On Error GoTo Err_NextBtn_Click DoCmd.GoToRecord , , acNext Exit_NextBtn_Click: Exit Sub Err_NextBtn_Click: MsgBox Err.Description Resume Exit_NextBtn_Click End Sub السجل السابق Private Sub PreviousBtn_Click() On Error GoTo Err_PreviousBtn_Click DoCmd.GoToRecord , , acPrevious Exit_PreviousBtn_Click: Exit Sub Err_PreviousBtn_Click: MsgBox Err.Description Resume Exit_PreviousBtn_Click End Sub السجل الأول Private Sub FirstBtn_Click() On Error GoTo Err_FirstBtn_Click DoCmd.GoToRecord , , acFirst Exit_FirstBtn_Click: Exit Sub Err_FirstBtn_Click: MsgBox Err.Description Resume Exit_FirstBtn_Click End Sub السجل الأخير Private Sub LastBtn_Click() On Error GoTo Err_LastBtn_Click DoCmd.GoToRecord , , acLast Exit_LastBtn_Click: Exit Sub Err_LastBtn_Click: MsgBox Err.Description Resume Exit_LastBtn_Click End Sub البحث عن سجل Private Sub FinedRecBtn_Click() On Error GoTo Err_FinedRecBtn_Click Screen.PreviousControl.SetFocus DoCmd.RunCommand acCmdFind Exit_FinedRecBtn_Click: Exit Sub Err_FinedRecBtn_Click: MsgBox Err.Description Resume Exit_FinedRecBtn_Click End Sub تكرار السجل Private Sub DublicateRecBtn_Click() On Error GoTo Err_DublicateRecBtn_Click DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdCopy DoCmd.RunCommand acCmdRecordsGoToNew DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdPaste Exit_DublicateRecBtn_Click: Exit Sub Err_DublicateRecBtn_Click: MsgBox Err.Description Resume Exit_DublicateRecBtn_Click End Sub حفظ السجل Private Sub SaveRecBtn_Click() On Error GoTo Err_SaveRecBtn_Click DoCmd.RunCommand acCmdSaveRecord Exit_SaveRecBtn_Click: Exit Sub Err_SaveRecBtn_Click: MsgBox Err.Description Resume Exit_SaveRecBtn_Click End Sub طباعة السجل الحالي Private Sub PrintRecBtn_Click() On Error GoTo Err_PrintRecBtn_Click DoCmd.RunCommand acCmdSelectRecord DoCmd.PrintOut acSelection Exit_PrintRecBtn_Click: Exit Sub Err_PrintRecBtn_Click: MsgBox Err.Description Resume Exit_PrintRecBtn_Click End Sub التراجع عن التسجيل Private Sub UndoRecBtn_Click() On Error GoTo Err_UndoRecBtn_Click DoCmd.RunCommand acCmdUndo Exit_UndoRecBtn_Click: Exit Sub Err_UndoRecBtn_Click: MsgBox Err.Description Resume Exit_UndoRecBtn_Click End Sub طباعة سجل محدد Private Sub Print_Click() On Error GoTo Err_PrintReportBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OpenReport stDocName, acViewPreview, , "ID=" & [ID] DoCmd.RunCommand acCmdPrint Exit_PrintReportBtn_Click: Exit Sub Err_PrintReportBtn_Click: MsgBox Err.Description Resume Exit_PrintReportBtn_Click End Sub طباعة تقرير Private Sub PrintReportBtn_Click() On Error GoTo Err_PrintReportBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OpenReport stDocName, acNormal Exit_PrintReportBtn_Click: Exit Sub Err_PrintReportBtn_Click: MsgBox Err.Description Resume Exit_PrintReportBtn_Click End Sub معاينة تقرير Private Sub VeiwReportBtn_Click() On Error GoTo Err_VeiwReportBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OpenReport stDocName, acPreview Exit_VeiwReportBtn_Click: Exit Sub Err_VeiwReportBtn_Click: MsgBox Err.Description Resume Exit_VeiwReportBtn_Click End Sub فتح تقرير Private Sub OpenReportBtn_Click() On Error GoTo Err_OpenReportBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OpenReport stDocName, acViewReport Exit_OpenReportBtn_Click: Exit Sub Err_OpenReportBtn_Click: MsgBox Err.Description Resume Exit_OpenReportBtn_Click End Sub حفظ تقرير بصيغة Private Sub SendReportToBtn_Click() On Error GoTo Err_SendReportToBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OutputTo acReport, stDocName Exit_SendReportToBtn_Click: Exit Sub Err_SendReportToBtn_Click: MsgBox Err.Description Resume Exit_SendReportToBtn_Click End Sub

شكرا جزيلا على الابداع انار الله دربك مثلما انرت عقولنا

السلام عليكم ورحمه الله نفذت كل ما طلبته والنتيجه 100% تمام الله يجزيك الخير عن كل حرف وشكرا لجهودك ********* اروع منتدى *******

شكر وتقدير واحترام من اخيك

بارك الله لك معلومات قيمة

يشرفني اكون اول من رد على ابداعك ..... جاري التجربة ..... شكرا لك ايها المبدع ....

ما دمت مصرا على تجاهل الخطأ في تنظيم البيانات واختلاف عدد السطور في كل عمود عن غيره في نفس الصف هذا الكود يبحث عن كلمة بكالوريوس ويجلب البيانات الموجودة في نفس السطر من جميع الأعمدة ويضعها في الأعمدة بداية من H:M مع تجاهل أي خطأ يقابله لذلك أنا شخصيا لست متأكدا بنسبة 100% من صحة النتائج لأن البيانات غير صحيحة من البداية Sub MasSplitText() Dim MyArray() As String, newcol As Long, i As Variant, lr As Long On Error Resume Next lr = Cells(Rows.Count, 1).End(3).Row Range("h2:m" & lr).ClearContents For c = 1 To 6 For rw = 2 To lr MyArray = Split(Cells(rw, 2), Chr(10)) newcol = c + 7 For i = 0 To UBound(MyArray) If MyArray(i) = "بكالوريوس" Then Cells(rw, newcol) = Split(Cells(rw, c), Chr(10))(i) Next i Next rw Next c MsgBox "Done by mr-mas.com" End Sub بالتوفيق

ويمكن هكذا أيضا Database1.rar

فورم المخزن كود اضافة شيت وكود حذف شيت واظهار اسماء الشيتات فيديو 3

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

جزاك الله خيرا اخي الفاضل وجعله الله في ميزان حسانتك اللهم امين ...هذا هو المطلوب

شكراً جزيلاً على مروركم الكريم

سلمت يداك على العمل الرائع

عليكم السلام ورحمة الله وبركاته يمكنك وضع هذه المعادلة في الخلية G5 =EDATE(F5,COUNT(I5:R5)-1) ثم سحبها لأسفل وهي لعد الشهور المسجلة في I5:R5 وإضافتها على تاريخ بداية الاشتراك إن شاء يكون المطلوب بالتوفيق

فنان ما شاء الله عليك وشرحك جميل هذا الحل ينهي المشكلة 100% بالنسبة لي افضل استبدال Me.Requery بـ Me.Recalc لان الهدف اعادة احتساب الحقول المحسوبة وليس اعادة تحميل البيانات وجهة نظر ومن باب تبادل الافكار -------------------------- فائدة اربعة اوامر يتشابهون للوهلة الاولى ولكل منهم استخدامه Requery لاعادة تحميل البيانات ويعيدنا للسجل الاول اشبه ما يكون باعادة اغلاق النموذج وفتحه Refresh يتعامل مع البيانات المعروضة في النموذج ولا يعيد تحميل مجموعة السجلات Repaint عندما نقوم بتغيير قيمة عدد من الحقول ولدينا حقول اخرى تعتمد قيمتها على تعبيرات محسوبة للحقول التي تم تغيير قيمتها قد يتأخر اكسس في اعادة الاحتساب لذا نستخدم هذا الامر وهو اشبه ما يكون باعادة رسم للنموذج وكافة عناصر تحكمه وله استخدامات اخرى لا يتسع المجال لذكرها ولكونها لا تبتعد كثيرا عن هذا الاطار Recalc يقوم بتحديث كافة العناصر المحسوبة في النموذج والله الموفق

وعليكم السلام-تفضل Option Explicit Private IsArrow As Boolean Private Sub ComboBox1_Change() Dim i As Long If Not IsArrow Then With Me.ComboBox1 .List = Worksheets("Sheet1").Range("A4", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value .ListRows = Application.WorksheetFunction.Min(6, .ListCount) .DropDown If Len(.Text) Then For i = .ListCount - 1 To 0 Step -1 If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i Next .DropDown End If End With End If End Sub Private Sub ComboBox1_DropButtonClick() With Me.ComboBox1 .List = Worksheets("Sheet1").Range("A4", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value .ListRows = Application.WorksheetFunction.Min(6, .ListCount) .DropDown End With End Sub Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Debug.Print Time; "KeyDown"; KeyCode; ComboBox1.ListIndex; ComboBox1.ListCount, ComboBox1.Value IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown) If KeyCode = vbKeyReturn Then Me.ComboBox1.List = Worksheets("Sheet1").Range("A4", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value ElseIf KeyCode = vbKeyTab Then With Me.ComboBox1 If .ListIndex = -1 Then .Value = .List(0) Else .Value = .List(.ListIndex) End If End With KeyCode = vbKeyReturn End If End Sub القائمة بالكومبوبوكس1.xlsm

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

السلام عليكم مشاركه مع اخى ومهندسنا العزيز @Eng.Qassim جزاه الله عنا كل خير 💐 قاعد البيانات المرفقه هى عباره عن واجه وغير مرفق قاعده البيانات الخلفيه التى تتصل معها قاعده البانات المرفقه مغلقه accde ومحول الامتداد لها accdb فيجب عليك مراجعه قاعده البيانات قبل التحويل وتعديل الكود الاخير الذى اضفته وقام بتعطيلها بالتوفيق

حاولت افتحه في حاسوب اخر نواة 32 ولم تظهر لي الرسالة اعلاه لكن ظهرت لي مشكلة ان النسخة معي 2010 ..والنسخة لديك احدث

تفضل مثالك بعد التعديل ..... وهذه صورة للنتيجة وبدون استعلام ظاهر .... kan.rar

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

طيب ... ايش رأيك في هذا ...... اذا كان ينفعك ... Me.RecordSource = "SELECT *FROM tbl_Employ IN 'C:\Users\ACER\Desktop\AdoForm\Adb_Dat.accdb'[access];"

تفضل اتمني ان يكون المطلوب . حفظ باسم pdf.accdb

XFD هو اخر عامود في في صفجة الاكسل و هل تريد اكثر من 16384 رقم متسلسل

يبدو ان اللغة العربية غير مثبتة عندك في برمجة الــVBA شاهد هذه الفيديو لحل المشكلة https://www.youtube.com/watch?v=hElkHVLg7a4

الأخ علي لا لزوم لهذه المعادلة الطويلة (لادراج من A الى Z ) تكفي هذه =IF(ROWS($A$1:A1)>26,"",CHAR(64+ROWS($A$1:A1))) ربما تنفع هذه الثلاث كودات Option Explicit Sub insert_arab() Dim i%, k% Dim arr() k = 0 Range("A1").CurrentRegion.ClearContents arr = Array(1, 2, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, _ 18, 19, 20, 21, 23, 24, 25, 27, 29, 30, 31, 32, 39) For i = LBound(arr) To UBound(arr) Range("A" & i + 1) = Chr(198 + arr(k)) k = k + 1 Next End Sub '++++++++++++++++++++++++++++++++++++ Sub insert_Cap() Range("C1").CurrentRegion.ClearContents Dim i% For i = 1 To 26 Range("C" & i) = Chr(64 + i) Next End Sub '++++++++++++++++++++++++++++++++++++++++++ Sub insert_Small() Range("F1").CurrentRegion.ClearContents Dim i% For i = 1 To 26 Range("F" & i) = Chr(96 + i) Next End Sub الملف مرفق ALPHABET.xlsm

وعليكم السلام-على الرغم انك لم تقم برفع ملف موضح عليه المطلوب بكل دقة , الا انى قمت بتصميم هذا لك , بداخل الملف طريقة عمل التسلسل بمعادلة عادية وطريقة أخرى بدالة معرفة Dynamic Serial by Letters.xlsm

كل عام وجميع الأحباب في الله بكل خير عيدكم مبارك

أخي علي مطر شخصياً أفضل كل جديد وحديث لأنه أكيد فيه مميزات ليست في النسخ السابقة لـــــذا أنصحك باستخدام أوفيس 2010

هل عدد الخلايا غير الملونة ثابت؟

أنا مش عارف إيه المطلوب ذالعمودين g و h متطابقين ولا يوجد بينهم فروق المعادلة في العمود g المراد تعديلها تعطي ما هو مطلوب في العمود h ياريت مزيد من التوضيح

يفضل إرفاق ملفك للتعديل عليه