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

تصحيح الكود Option Explicit Dim i%, Lr% Dim T As Worksheet Dim Spes_sh As Worksheet Dim Flter_rg As Range Sub ADD_Sheets() Set T = Sheets("بيان") If T.AutoFilterMode Then T.Range("A8").AutoFilter Lr = T.Cells(Rows.Count, 2).End(3).Row If Lr < 2 Then Exit Sub With T For i = 9 To Lr If Not Application.Evaluate("ISREF('" & _ .Range("C" & i) & "'!A8)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = _ .Range("C" & i) End If Next End With End Sub '+++++++++++++++++++++++++++ Sub transfer_data() Application.ScreenUpdating = False ADD_Sheets If Lr < 9 Then Exit Sub Set Flter_rg = T.Range("A8").CurrentRegion For Each Spes_sh In Sheets If Spes_sh.Name = T.Name Or Spes_sh.Name = "Justify" Then Else Spes_sh.Range("A8").CurrentRegion.ClearContents Flter_rg.AutoFilter 3, Spes_sh.Name Flter_rg.SpecialCells(12).Copy Spes_sh.Range("A8").PasteSpecial (8) Spes_sh.Range("A8").PasteSpecial (xlPasteAll) End If Next If T.AutoFilterMode Then T.Range("A8").AutoFilter T.Select With Application .ScreenUpdating = True .CutCopyMode = False End With End Sub Yasser_Filter.xlsm

السلام عليكم اخواني الكرام يسرني ان أقدم لكم هدية متواضعة وهي عبارة عن برنامج صغير لطباعة بطاقات العمل البلاستيكية مفتوح المصدر أقدمت على عمل هذا البرنامج بطلب من أحد الاخوة واهدي منه نسخة الى اخواني في المنتدى البرنامج شغال وقمت بتجربته على طابعة البطاقات يعمل 100% والحمد لله .. انت فقط اضبط اعدادات الطابعة جيداً يمكنك تغيير خلفيات البطاقات على راحتك لان صور خلفيات البطاقات معمولة بالفوتوشوب وجميع المعلومات هي افتراضية وغير حقيقية اسم المستخدم : اوفيسنا رمز المرور : 1234 حمل البرنامج من الرابط المباشر ادناه https://www.mediafire.com/file/yz3abye3mekko8z/234.rar/file الشكر موصول للأستاذ الخبير ابا جودي المحترم لأبداء المساعدة لنا اخواني ذا كانت هناك أخطاء لا تبخلوا علينا بالتنبيه ومنكم نستفيد لا تنسونا بالدعاء ولوالدي بالرحمة والمغفرة -------------------------------------------------------------------------------- 30-11-2020 النسخة المعدلة ، بصيغتي mdb و accdb 🙂 1289.اوفيسنا.zip

حرب هذا الملف jakord.xlsm

جرب هذا الملف 1- دبناميكي اي انه بضيف اسم الشيت المستجدثة او توماتيكياً الى القائمة المنتسدلة (الخلية الصفراء) (في حال اضافة شيت جديد) 2-قم بتسمية الأوراق حسب اسم الطالب الذي تحتويه كما في الصورة المرفقة 3- تم التعديل على المعادلات كي لا يكون هناك أخظاء قي حال كتابة قيمة ليست رقماً في اي خلية (الصورة) 4- كان يجب تعبئة الجداول ولا تترك هذا الشيء لمن يريد ان يساعدك 5- اختر من القائمة المنسدلة اسم الشيت ثم اضغط على الزر Run 6- الملف مرفق sohail.xlsm

الكود الثّاني Option Explicit Dim i%, Max_ro%, m% Dim J As Worksheet Dim ro%, col%, my_sum# Dim Spes_sh As Worksheet Dim D1 As Date, D2 As Date '+++++++++++++++++++++++++++++++++++ Sub Fil_data_All() Application.ScreenUpdating = False Set J = Sheets("Justify") J.Range("A5:O5000").Clear If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then MsgBox "Type Please a reel date in B2 and C2" GoTo Live_Me_PLease End If D1 = Application.Min(J.Range("B2"), J.Range("C2")) D2 = Application.Max(J.Range("B2"), J.Range("C2")) J.Range("B2") = D1: J.Range("C2") = D2 For Each Spes_sh In Sheets If Spes_sh.Name = "Tarhil" Or Spes_sh.Name = "Justify" Then Else Max_ro = Spes_sh.Cells(Rows.Count, 2).End(3).Row Spes_sh.Range("A2").Resize(Max_ro - 1, 16) _ .Interior.ColorIndex = 35 For col = 3 To 16 my_sum = 0 For ro = 2 To Max_ro If Spes_sh.Cells(ro, 1) <= D2 And _ Spes_sh.Cells(ro, 1) >= D1 Then Spes_sh.Cells(ro, 1).Interior.ColorIndex = 40 Spes_sh.Cells(ro, col).Interior.ColorIndex = 40 my_sum = my_sum + Val(Spes_sh.Cells(ro, col)) End If Next ro ro = J.Cells(Rows.Count, "O").End(3).Row m = IIf(ro <= 3, 5, ro + 1) J.Cells(m, col - 1) = my_sum J.Cells(m, 1) = Spes_sh.Name Next col End If Next Spes_sh If m > 5 Then J.Cells(m + 1, 1) = "SUM" J.Cells(m + 1, 2).Resize(, 14).Formula = _ "=SUM(B5:B" & m & ")" J.Cells(5, "O").Resize(m - 4).Formula = _ "=SUM(B5:N5)" With J.Cells(5, 1).Resize(m - 3, 15) .HorizontalAlignment = xlCenter .Borders.LineStyle = 1: .Font.Size = 14 .Font.Bold = True .Value = .Value .InsertIndent 1 End With J.Cells(m + 1, 1).Resize(, 15).Interior.ColorIndex = 40 End If Live_Me_PLease: Application.ScreenUpdating = True End Sub

حسنا اخي الكريم اضغط على كود الصنف النموذج الفرعي سيظهر نموذج الاصناف اختار الاصناف ثم اضغط موافق وانظر النتيجية Hmza.rar تحياتي

لان جدول Table_StorExch مرتبط بعلاقة مع جدول Table_StorPri لذلك يجب تحديد رقم Id اولاً انظر الاستعلام Query1 Hmza.rar تحياتي

لا يمكن عمل هذا لأن الاكسل لا يعرف ماذا تكتب في الخلايا هو صعب أوي الضغط على الزر؟؟؟؟

السلام عليكم استاذي الفاضل ابا جودي انا عندي هذا الكود يعمل نفس العمل الذي قمت به بدون موديول سؤوالي هل يوجد فرق بين الكدين Private Sub ww_NotInList(NewData As String, Response As Integer) Dim ctl As Control Dim strSQL As String Set ctl = Me!ww DoCmd.Beep If MsgBox(" القيمة النصية التي أضفتها" & " / " & _ Me.ww.Text & " / ليس من ضمن القائمة هل تريد إضافتها الى القائمة ", _ vbInformation, "!! ... انتباه") = vbOK Then Response = acDataErrAdded strSQL = "INSERT INTO tbl_city(city) VALUES('" strSQL = strSQL & NewData & "');" CurrentDb.Execute strSQL DoCmd.Beep MsgBox "تمت إضافة القيمة الجديدة المكتوبة الى القائمة بنجاح", , "الإضافة الجديدة" Else Response = acDataErrContinue ctl.Undo End If End Sub

تفضل لك ما طلبت ... وذلك لوجود مسافات زائدة بالمعادلة , تم حذفها ,ورجاءاً لابد ان تكون نهايات فورمات الملف XLSX وليس XLS محمد4.xlsx

وعليكم السلام-تفضل ما تريد بالتنسيقات الشرطية. وتم ايضاً لعمل قائمة منسدلة لإختيار الحروف المطلوبة نظام التقييم للصف االاول بالألوان1.xlsx

وعليكم السلام-تفضل وذلك بإستخدام هذه المعادلة =IF(F3=TODAY()-7,TEXT(F3,"b2dddd")&" , "&"الماضى "&"("&TEXT(F3,"d ")&VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",IF(F3=TODAY()-1,TEXT(F3,"b2dddd")&" , "&"أمس "&"("&TEXT(F3,"d ")&VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",IF(F3=TODAY(),TEXT(F3,"b2dddd")&" , "&"اليوم "&"("&TEXT(F3,"d ")&VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",IF(F3=TODAY()+1,TEXT(F3,"b2dddd")&" , "&"غداً "&"("&TEXT(F3,"d ") & VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",IF(F3=TODAY()+7,TEXT(F3,"b2dddd")&" , "&"القادم "&"("&TEXT(F3,"d ")&VLOOKUP(MONTH(F3),$M$3:$N$14,2,0)&")",""))))) 2.xlsx

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

الله يرضى عنك وعن والديك بس الكود الثانى لم يتم فيه التعديل التعديل شمل كود واحد فى البرنامج الاستدعاء حضرتك عامل لى كود ين واحد تم تعديله والاخر لم يتم متتعبش حضرتك اشرح لى وانا هعدل انا بشكرك زاد الله علمك وكرمك الكود الاخر هو Application.ScreenUpdating = False Set J = Sheets("Justify") J.Range("A5:L5000").Clear If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then MsgBox "Type Please a reel date in B2 and C2" Exit Sub End If D1 = Application.Min(J.Range("B2"), J.Range("C2")) D2 = Application.Max(J.Range("B2"), J.Range("C2")) J.Range("B2") = D1: J.Range("C2") = D2 For Each Spes_sh In Sheets If Spes_sh.Name = "Tarhil" Or Spes_sh.Name = "Justify" Then Else Max_ro = Spes_sh.Cells(Rows.Count, 2).End(3).Row Spes_sh.Range("A2").Resize(Max_ro - 1, 11) _ .Interior.ColorIndex = 35 For col = 3 To 11 my_sum = 0 For ro = 2 To Max_ro If Spes_sh.Cells(ro, 1) <= D2 And _ Spes_sh.Cells(ro, 1) >= D1 Then Spes_sh.Cells(ro, 1).Interior.ColorIndex = 40 Spes_sh.Cells(ro, col).Interior.ColorIndex = 40 my_sum = my_sum + Val(Spes_sh.Cells(ro, col)) End If Next ro ro = J.Cells(Rows.Count, "j").End(3).Row m = IIf(ro = 3, 5, ro + 1) J.Cells(m, col - 1) = my_sum J.Cells(m, 1) = Spes_sh.Name Next col End If Next Spes_sh If m > 5 Then J.Cells(m + 1, 1) = "SUM" J.Cells(m + 1, 2).Resize(, 9).Formula = _ "=SUM(B5:B" & m & ")" J.Cells(5, "J").Resize(m - 4).Formula = _ "=SUM(B5:I5)" With J.Cells(5, 1).Resize(m - 3, 10) .HorizontalAlignment = xlCenter .Borders.LineStyle = 1: .Font.Size = 14 .Font.Bold = True .Value = .Value .InsertIndent 1 End With J.Cells(m + 1, 1).Resize(, 10).Interior.ColorIndex = 40 End If Application.ScreenUpdating = True End Sub

خلاص بفى احر مناقشة بهذا الموضوع الكود بعد التعديل Option Explicit Dim i%, Max_ro%, K%, m%, All_rows% Dim J As Worksheet Dim Spes_sh As Worksheet Dim D1 As Date, D2 As Date Dim x As Boolean '+++++++++++++++++++++++++++++++++++ Sub Fil_data() Application.ScreenUpdating = False Dim t%, cont%, n% m = 5: t = 5 Set J = Sheets("Justify") All_rows = J.Cells(Rows.Count, 1).End(3).Row If All_rows > 4 Then J.Range("A5:O" & All_rows + 5).Clear End If If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then MsgBox "Type Please a reel date in B2 and C2" GoTo Buy_Buy_Ya_Helween End If D1 = Application.Min(J.Range("B2"), J.Range("C2")) D2 = Application.Max(J.Range("B2"), J.Range("C2")) J.Range("B2") = D1: J.Range("C2") = D2 For Each Spes_sh In Sheets If Spes_sh.Name = "Tarhil" Or Spes_sh.Name = "Justify" Then Else Max_ro = Spes_sh.Cells(Rows.Count, 2).End(3).Row If Max_ro = 1 Then GoTo Next_SHeeet For K = 2 To Max_ro If Spes_sh.Cells(K, 1) <= D2 _ And Spes_sh.Cells(K, 1) >= D1 Then J.Cells(m, 2).Resize(, 14).Value = _ Spes_sh.Cells(K, 3).Resize(, 14).Value If Not x Then J.Cells(m, 1) = Spes_sh.Name End If x = True m = m + 1 End If Next K End If x = False Next_SHeeet: If Spes_sh.Name = "Tarhil" Or _ Spes_sh.Name = "Justify" Then Else J.Cells(m, 1) = "Sum" J.Cells(m, 2).Resize(, 14).Formula = _ "=SUM(B" & t & ":B" & m - 1 & ")" m = m + 1 t = m End If x = False Next Spes_sh If m > 5 Then For cont = 5 To m - 1 If J.Cells(cont, 1) = "Sum" Then J.Cells(cont, 1).Resize(, 15). _ Interior.ColorIndex = 35 End If Next cont J.Cells(m, 1) = "Sum Of ALL" J.Cells(m, 2).Resize(, 14).Formula = _ "=SUM(B5:B" & m - 1 & ")/2" J.Cells(m, 1).Resize(, 15).Interior.ColorIndex = 40 With J.Cells(5, 1).Resize(m - 4, 15) .HorizontalAlignment = xlCenter .Borders.LineStyle = 1: .Font.Size = 14 .Font.Bold = True .Value = .Value .InsertIndent 1 End With End If Buy_Buy_Ya_Helween: Application.ScreenUpdating = True End Sub الملف مرفق Om_Hamz_Super.xlsm

ما شاء الله، اطلعت على الإضافة الجديدة، وهي جميلة ومفيدة، بارك الله فيك أساذ شحادة.

بارك الله فيك استاذ سليم وبعد اذن حضرتك ولإثراء الموضوع -يمكن أيضاً استخدام هذه المعادلة بداية من الخلية N3 سحباً يساراً وأسفل =COUNTIFS($H$3:$H$500,"<="&$M3,$H$3:$H$500,">="&$L3,$I$3:$I$500,N$2) Countifs,معادلة احصاء عدد الذكور والإناث بين تاريخين.xlsx

في الخلية (N3) هذه المعادلة واسجب عامودين و 7 أعمدة =SUMPRODUCT(--($H$3:$H$53<>""),--($H$3:$H$53<=$M3),--($H$3:$H$53>=$L3),--($I$3:$I$53=N$2)) الملف مرفق Mustafa.xlsx

أرغب في كود إخفاء صف يحتوي على قيمة صفر مرفق ملف للعمل عليه مع الشكر مقدما الخلاصة.xlsx

بالتوفيق اخي الكريم تحياتي

[الجديد في التحديث 4.20]: في قائمة بحث واستبدال، تم إضافة خاصية بحث في ملفات متعددة، تُمكِّنك هذه الخاصية من البحث عن نص ضمن مجلد أو مسار يحوي عدة ملفات Word بامتداد docx، ثم تظهر لك النتائج، وتُعرض كل الفقرات التي توجد فيها العبارة ضمن المستند، كما يتوفر خيارات لنسخ فقرة ما أو نسخ جميع الفقرات، مع إمكانية فتح الملف المحدد أو فتح موقعه.

وعليكم السلام ورحمة الله وبركاته لتحديد الكل نستخدم استعلام تحديث كالتالي DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE TableItem SET TableItem.Selc = -1;" DoCmd.SetWarnings True Me.Requery ولالغاء تحديد الكل DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE TableItem SET TableItem.Selc = 0;" DoCmd.SetWarnings True Me.Requery ولنسخ البيانات الى جدول اخر نستخدم استعلام الحاق كالتالي DoCmd.SetWarnings False DoCmd.OpenQuery "Query1" DoCmd.SetWarnings True Me.Requery Hmza.rar تحياتي

لا يا اخى الكريم المرفق الاول كانت بداية الافكار فضلا وكرما وليس امرا قم بتجربة هذا المرفق النهااااااااائى و اخبرنى بنتيجة التجربة رجاء تعديل.zip

أضف اختيارا إلى قائمة مربع التحرير والسرد عن طريق إضافة سجل إلى الجدول الخاص بمصدر الصف في حدث NotInList لمربع التحرير والسرد. الكود داخل الموديول Public Sub CmboNotInList(ByVal strTableName As String, ByVal strFieldName As String, ByVal strNewData As String, ByRef intResponse As Integer) On Error GoTo Proc_Err Dim sSQL As String Dim sMsg As String intResponse = acDataErrContinue sMsg = """" & strNewData & """ is not in the current list. " & vbCrLf & vbCrLf & "Do you want to add it? " If MsgBox(sMsg, vbYesNo, "Add New Data") <> vbYes Then GoTo Proc_Exit End If sSQL = "INSERT INTO [" & strTableName & "] " & "([" & strFieldName & "])" & " SELECT """ & strNewData & """;" With CurrentDb .Execute sSQL If .RecordsAffected > 0 Then intResponse = acDataErrAdded End If End With Proc_Exit: Exit Sub Proc_Err: MsgBox Err.Description, , "ERROR " & Err.Number & " CmboNotInList" Resume Proc_Exit Resume End Sub يتم استدعاء الكود فى الحدث >>------> عند عدم الوجود فى القائمة - NotInList من خلال الكود الاتى Call CmboNotInList("tableName", "FieldName", NewData, Response) المرفق Not In List.mdb

شكرأ اخي وصلت الفكرة بارك الله بجهودك

لا خالص ما فى اى فرق النتيجة واحدة ولكن لو كنت اريد تكرار الطريقة مع اكثر من مربع سرد سوف تكتب كل تلك الاسطر مع كل مربع ولكن ان كان الكود فى الموديول يكتب مرة واحدة ويتم فى كل مرة كتابة سطر واحد لاستدعائه Call CmboNotInList("tableName", "FieldName", NewData, Response) وكل الطرق تؤدى الى روما

وعليكم السلام 🙂 رحم الله والديك على هذه المعلومة ، الظاهر اني ما التفت لها ، من سنين 😁 العمل على جدول tbl_Months : بالإضافة الى تعديل خطأ تسلسل الايام ، قمت بتعديل جميع المسميات ، آخذاً المسميات من الكمبيوتر ، بالتشكيلة 🙂 عندك اختيارين : تحذف الجدول من برنامجك ، ثم تستورد الجدول من البرنامج المرفق ، سواء من قاعدة البيانات او ملف الاكسل ، تعدل على جدولك يدويا حسب بيانات الصورة ادناه ، او الملفات المرفقة : جعفر tbl_Months.zip tbl_Months.xlsx

تفضل ولكن كان عليك رفع ملف موضح عليه المطلوب بكل دقة المستخدم (المدير) الباسورد (1) وهذا برنامج أخر موجود داخل المنتدى ... كان عليك استخدام خاصية البحث بالمنتدى هدية - برنامج تقسيط وهذا برنامج ثالث , أيضاً من داخل المنتدى الرجاء المساعدة في برنامج البيع بالتقسيط وتلك برنامج رابع أسفل فيديو الشرح برنامج المحل شراء وبيع وتقسيط اكسس Access برنامج البيع بالتقسيط 2009.rar

1-اكتب ما تريد داحل الخلية C3 و ترى انها لا تأخذ الا القيمة القديمة وتضيف 2 2- أكبر عدد تريد الوصول اليه اكتبه في الخلية F2 3-اذا وضعت في الخلية F2 نص او تركتها فارغة او عدد سالب فأن الافتراضي فيها هو 50 (اي اتها تأخذ القيمة 50 اوتوماتيكياً) 4- بعد ان تتجاوز قيمة الحلية C3 العدد الموجود في F2 تعود الى 1 Odd_Numbering.xlsm

تفضل هذا المثال ارجو ان ينفعك aaa.rar

وعليكم السلام-اجعل المعادلة هكذا =IF(A2="","",NETWORKDAYS.INTL(A2,TODAY(),7)) 1تاريخ البدء.xlsx

رحم الله والديك ، التشخيص الصحيح نصف الحل (اذا ما كان مثل مشهور ، فخذه مني 🙂 ) ، وبه الحمدلله وجدنا الحل (ولأول مرة في حياتي احول تاريخ الكمبيوتر الى الهجري/ام القرى 🙂 ) يا رجال ، مين هذا الاستاذ اللي تتكلم عنه ؟ و ويش دخله في موضوعنا 😁 واذا كنت تتكلم عني انا ، فيا رجال ما عندي ولا حتى الرخصة الدولية في استخدام الكمبيوتر ICDL 😁 انا جعفر والسلام 🙂 جعفر والسلام 1281.7.FRm_Refresh.accdb.zip

تم عمل المطلوب كما تريدين Option Explicit Dim i%, Max_ro%, m% Dim J As Worksheet Dim ro%, col%, my_sum# Dim Spes_sh As Worksheet Dim D1 As Date, D2 As Date '+++++++++++++++++++++++++++++++++++ Sub Fil_data_All() Application.ScreenUpdating = False Set J = Sheets("Justify") J.Range("A5:L5000").Clear If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then MsgBox "Type Please a reel date in B2 and C2" Exit Sub End If D1 = Application.Min(J.Range("B2"), J.Range("C2")) D2 = Application.Max(J.Range("B2"), J.Range("C2")) J.Range("B2") = D1: J.Range("C2") = D2 For Each Spes_sh In Sheets If Spes_sh.Name = "Tarhil" Or Spes_sh.Name = "Justify" Then Else Max_ro = Spes_sh.Cells(Rows.Count, 2).End(3).Row Spes_sh.Range("A2").Resize(Max_ro - 1, 11) _ .Interior.ColorIndex = 35 For col = 3 To 11 my_sum = 0 For ro = 2 To Max_ro If Spes_sh.Cells(ro, 1) <= D2 And _ Spes_sh.Cells(ro, 1) >= D1 Then Spes_sh.Cells(ro, 1).Interior.ColorIndex = 40 Spes_sh.Cells(ro, col).Interior.ColorIndex = 40 my_sum = my_sum + Val(Spes_sh.Cells(ro, col)) End If Next ro ro = J.Cells(Rows.Count, "j").End(3).Row m = IIf(ro = 3, 5, ro + 1) J.Cells(m, col - 1) = my_sum J.Cells(m, 1) = Spes_sh.Name Next col End If Next Spes_sh If m > 5 Then J.Cells(m + 1, 1) = "SUM" J.Cells(m + 1, 2).Resize(, 9).Formula = _ "=SUM(B5:B" & m & ")" J.Cells(5, "J").Resize(m - 4).Formula = _ "=SUM(B5:I5)" With J.Cells(5, 1).Resize(m - 3, 10) .HorizontalAlignment = xlCenter .Borders.LineStyle = 1: .Font.Size = 14 .Font.Bold = True .Value = .Value .InsertIndent 1 End With J.Cells(m + 1, 1).Resize(, 10).Interior.ColorIndex = 40 End If Application.ScreenUpdating = True End Sub الملف مرفق (الكود القديم ما زال يعمل اذا كانت هناك حاجة اليه) Om_Hamz_Matloub.xlsm

وعليكم السلام 🙂 اعمل استعلام لكل جزء ، ثم اجمعهم في استعلام آخر: . والنتيجة : . جعفر 1287.beh.accdb.zip

اخى الكريم هل يمكن ان تقوم المعادلة بعكس النصوص فقط بدون الارقام شكرا اخى الفاضل هل يمكنك تعديل الكود ليقوم بتعدل الاحرف المعكوسة ويبقى الارقام كما هى ؟ وجزاكم الله كل خير لان فيه نصوص متضمنة ( ارقام غير معكوسة ) والمعادلة تعكس الارقام ايضا

تم اضافة معادلة عن طريق vba =ReverseTxt(B2) استخدم المعادلة في الملف المرفق وبالتوفي ق نص معكوس.xlsm

السلام عليكم 🙂 ومثل ما قال الاخ Kanory ، وببعض التعديل على الكود ليتناسب مع اسماء الحقول 🙂 جعفر 1274.t_fdate.mdb.zip

انت طلبت التعديل على هذا الماكرو فقط

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