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

السلام عليكم ورحمة الله وبركاته تحية طيبة وبعد ... كل عام وأنتم بخير وبصحة وسلامة إن شاء الله .. اتمنى ان يكون عام 2021 عام خير على أمة محمد أجمعين. بالنسبة لموضوعي الذي احببت مشاركتكم إياه فهو نادر مايستخدم ولكن قد يحتاجه احد ما كما احتجت له أنا وهو عملية إجبار المستخدم على ادخال كلمة في مربع نص على ان تكون الكلمة بالعربي وليس بالانجليزي وفي نفس الوقت عدم السماح له بإدخال ارقام في مربع النص وهو الامر عتبر غير شائع الاستعمال في الاكسس لكون ان المستخدم دائماً يكون هو المسؤول عن إدخالاته .. لكن في بعض الأحيان قد تحتاج الى فرض قيود صارمة على المستخدمين العابثين ومنعهم من حرية الاختيار عند ادخال بيانات معينة واجبارهم على ادخال ارقام او حروف انجليزي فقط او عربي .. الخ . إليكم الكود التالي الذي يجبر المستخدم على الكتابة بالعربي فقط في مربع النص .. يتم وضعه في حدث "عند الضغط على مفتاح" Select Case KeyAscii Case 48 To 57, 65 To 90, 97 To 122 ' Numbers and english letters KeyAscii = 0 Exit Sub End Select الارقام من 48 الى 57 هي للأرقام والباقي للحروف الانجليزية تحياتي

تم معالجة الأمر بالنسبة (للبحث فقط) والباقي عليك لضيق الوقت ismail.xlsm

السلام عليكم هل هذا ما تريد اخى بالتوفيق tt.accdb

هذه هي الاخطاء اللي ستأتي للمستخدم اللي عندي نظام انجليزي ، اعمل ملف جديد ، واستورد الكائنات بالترتيب التالي: الجداول ، الاستعلامات ، الماكرو ، الوحدات النمطية ، النماذج ، التقارير ، وبعض الاوقات تضطر ان تستورد كائن كائن ، ولما يعطيك الاكسس خطأ ، فتقوم بمعالجة هذا الكائن ، ثم تستورد غيره 🙂 طريقة اخرى لتغيير كائنات الاكسس : تغيير مسميات كائنا اكسس دفعة واحدة - قسم الأكسيس Access - أوفيسنا (officena.net) هذه احد الطرق ، ولكن مافي داعي استعمالها ، لأنك ستضع في الجدول الجملة بالعربي ، وعلشان خاطرك عملتها لك ، وبدل Debug.Print استعمل msgbox : . ينطبق عليك قول الشاعر : جاءت معذبتي في غيهب الغسق : هذا برنامجك وانت سهران عليه ، وهو معذبك ، فجاوبتني و دمع العين يسبقها ، من يركب البحر لا يخشى من الغرق : هاي احنا الشباب نشجعك (بس دمع العين للدلع 🙂 ) جعفر

هل من الممكن أن يتم إنشاء شيتات تلقائية باسم البيانات الجديدة ممكن هذا الشيء 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("تسجيل_الموظفين") Lr = T.Cells(Rows.Count, 2).End(3).Row If Lr < 8 Then Exit Sub With T For i = 8 To Lr If Not Application.Evaluate("ISREF('" & _ .Range("B" & i) & "'!A1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = _ .Range("B" & i) End If Next End With End Sub '+++++++++++++++++++++++++++ Sub transfer_data() Application.ScreenUpdating = False ADD_Sheets T.Select Set Flter_rg = T.Range("A7").CurrentRegion For Each Spes_sh In Sheets If Spes_sh.Name <> T.Name Then Flter_rg.AutoFilter 2, Spes_sh.Name Flter_rg.SpecialCells(12).Copy Spes_sh.Range("A7").PasteSpecial (8) Spes_sh.Range("A7").PasteSpecial xlAll End If Next Spes_sh T.AutoFilterMode = False T.Select With Application .ScreenUpdating = True .CutCopyMode = False End With End Sub Hatem_new.xlsm

السلام عليكم 🙂 من هذا الموضوع: اليك خلاصة طلبك : . والامر NZ معناه Null to Zero ، اي يحول حقل الـ Null وهو الحقل الذي لم يتم في ادخال اي معلومة ، وهو غير الحقل الذي تكون قد ادخلت فيه معلومة ثم حذفتها ، فالامر الاول يصيد هذه القيمة كذلك 🙂 جعفر

يمكن استخدام دالة NZ() NZ([القيمة])

السلام عليكم ورحمة الله وبركاته اضافة .. بالمعادلات .. sumifs .. اجمالي المبلغ =SUMIFS(D5:D10,C5:C10,"="&C2,B5:B10,"<="&B2,B5:B10,">="&A2) اجمالي الديون =SUMIFS(E5:E10,C5:C10,"="&C2,B5:B10,"<="&B2,B5:B10,">="&A2) SUMPRODUCT اجمالي المبلغ =SUMPRODUCT(--(B5:B10<=B2),--(B5:B10>=A2),--(C5:C10=C2),D5:D10) اجمالي الديون =SUMPRODUCT(--(B5:B10<=B2),--(B5:B10>=A2),--(C5:C10=C2),E5:E10) المبلغ عن مدة.xlsm

1-في شيت تسجيل_الموظفين اترك الصف رقم 6 فارغاً تماما تم اخفاه لعدم الكتابة فيه عن طريق الخطأ 2- في باقي الشيتات اترك الصف رقم 7 فارغاً تماما تم اخفاه لعدم الكتابة فيه عن طريق الخطأ 3- الكود المطلوب Option Explicit Sub My_filter() Dim Ash, Itm Dim Rg As Range Dim Main As Worksheet Dim Ro With Application .Calculation = xlCalculationManual .ScreenUpdating = False End With Ash = Array("التغذية", "تنسيق التعليم الإعدادي", _ "مكتب المدير العام", "شئون الطلبة والامتحانات") Set Main = Sheets("تسجيل_الموظفين") Ro = Main.Cells(Rows.Count, "B").End(3).Row Set Rg = Main.Range("A7").CurrentRegion Main.AutoFilterMode = False For Each Itm In Ash Sheets(Itm).Range("A8").CurrentRegion.Clear Rg.AutoFilter 2, Itm Main.Range("A8:Ar" & Ro).SpecialCells(12).Copy With Sheets(Itm).Range("A8") .PasteSpecial (8) .PasteSpecial (12) With .CurrentRegion .Borders.LineStyle = 1 .Font.Bold = True .Font.Size = 14 .InsertIndent 1 End With End With Next With Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With Main.Select Main.AutoFilterMode = False End Sub الملف مرفق Hatem.xlsm

هذا الموضوع بيفيدك

جمع تلقائي اكتب في أول صف فارغ من الخلية B الى الخلية E و عندما تكتمل البيانات في هذا الصف (4 عتاصر يقوم الماكرو بعمله) الصورة توضح ذلك (الملف مرفق) Summation_1.xlsm

جرب هذا الملف تضع في الخلية E1 اي رقم تريد وتطهر لك قائمة منسدلة من 1 حتى هذا الرقم في جال الجطأ الحلية E1 تساوي 1 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address(0, 0) = "E1" _ And Target.Count = 1 _ And Val(Target) > 0 Then If Target < 1 Then Target = 1 Target = Int(Target) Me.Range("E1") = Target Tajriba End If Application.EnableEvents = True End Sub '++++++++++++++++++++ Sub Tajriba() Dim Mon_Array, s Dim y%: y = Range("E1") s = "Row(" & 1 & ":" & y & ")" Mon_Array = Application.Transpose(Evaluate(s)) With Range("A1").Validation .Delete .Add 3, Formula1:=Join(Mon_Array, ",") End With Range("A1") = 1 End Sub Var_dat_val.xlsm

سأعرض الحل هنا مع توضيح بعض النقاط المهمة فالجملة البرمجية التي تستخدم لفتح ثم طباعة الصفحات المحددة من التقرير DoCmd.OpenReport stDocName, acPreview DoCmd.PrintOut acPages, pageFrom, pageTo لا تقوم بالمهمة كما ينبغي وكما رسمت له فمن المعلوم ان تنفيذ هذا الكود سيكون من خلال النموذج لذا يصعب التنفيذ بل يمتنع وتظهر بعض العقبات غير المتوقعة فمنها : - طباعة النموذج بدلا من التقرير وقد يتم طباعة الاثنين معا - عدم طباعة الصفحات المحددة وانما يتم طباعة الجميع - هذا الكود يقوم بفتح التقرير وهذه مشكلة بحد ذاتها حيث يستلزم اخفاؤه او تصغيره ثم غلقه وهل هناك بديل ؟ نعم وهو يقوم بكل لطف وصمت بطباعة صفحات محددة من تقارير عدة والحل سطران فقط ومن اراد الزيادة فعليه ان يكررهما ما شاء الاول يقوم بتحديد التقرير لا فتحه DoCmd.SelectObject acReport, "استقطاعات", True والثاني لطباعة الصفحات المحددة DoCmd.PrintOut , 14, 13, , 1 رقم 1 يمثل عدد النسخ في المرفقات تحقيق وتطبيق طباعة واختيار الصفحات من عدة تقارير.rar

بالخدمة استاذ ابا جودي نظام التشغيل ويندوز 7 والنواه 64 Bit اضفت المكتبتين لكن نفس المشكلة فقط صوت المراه , صوت المراة مصر ان يحتل المشهد اصل المراه مسيطرة عندي والظاهر ان البرامج عندي تشتغل بنفس برمجتي

نعم ظهرت هذه الرسالة عندي رغم ان صوت المراة هو الشغال

عندى اخطا التاى

لا ما اعرفش ازاى ؟ حبيبى تسلم لى يا قمر شكرا على الاطراء الجميل ☺️ طيب فى رسائل أخطاء ظهرت لحضرتك ؟

يا جماعة الموضوع الاصلى عرض على الشاشة

الكود كما تريد Option Explicit Dim i%, Lr% Dim T As Worksheet Dim Spes_sh As Worksheet Dim Flter_rg As Range Dim RO% Sub ADD_Sheets() Set T = Sheets("تسجيل_الموظفين") Lr = T.Cells(Rows.Count, 2).End(3).Row If Lr < 8 Then Exit Sub With T For i = 8 To Lr If Not Application.Evaluate("ISREF('" & _ .Range("B" & i) & "'!A1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = _ .Range("B" & i) End If Next End With End Sub '+++++++++++++++++++++++++++ Sub transfer_data() Application.ScreenUpdating = False ADD_Sheets T.Select Set Flter_rg = T.Range("A7").CurrentRegion For Each Spes_sh In Sheets If Spes_sh.Name <> T.Name Then Spes_sh.Range("A7").CurrentRegion.Clear Flter_rg.AutoFilter 2, Spes_sh.Name Flter_rg.SpecialCells(12).Copy With Spes_sh.Range("A7") .PasteSpecial (8) .PasteSpecial (12) .PasteSpecial (4) End With RO = Spes_sh.Cells(Rows.Count, 1).End(3).Row If RO > 7 Then Spes_sh.Range("A8").Resize(RO - 7).Value = _ Evaluate("Row(1:" & RO - 7 & ")") End If End If Next Spes_sh T.AutoFilterMode = False T.Select With Application .ScreenUpdating = True .CutCopyMode = False End With End Sub الملف لآحر مرة و سوف يغلق الموضوع بعد الرد مباشرة لأنه أخذ ما يزيد من الوقت Hatem_Last.xlsm

ابداع استاذ ابا جودى وتسلم ايديك بالمناسبة صوت الرجل غير شغال لكن مو مهم اهم شي صوت المراة شغال

تم التعديل خطوات العمل كما في الصورة 1- تكتب في التكست بوكس الحرف(الحروف التي تريدها) 2-تحتار من الليست بوكس الصفوف التي تريدها (باستعمال الــ Ctrl أو Shift ) 3- تضغط على الزر Add To sheet 4- عندما يزيد عدد الصقوف (في الشيت) عن العدد 60 يتم التسجيل ابتداء من أول اللائحة (الملف مرفق) ismail_1.xlsm

تمام كنت أريد التاكد ان رقم الخطأ لن يتغير فضلا وكرما دكتور عندما يسمح وقتكم تجربة المرفق الاتى اذا تم تلافى رسالة الحطأ ام لا Waiting Role.mdb

ظهرت الرساله بشكل اخر

تفضل أخي Sample filter.accdb

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

انا عندى ويندوز 7 وهذه صورة الرسالة تكرما منك عايزك تدخل على السؤال الذى طرحته اليوم لحسن من الصباح وانا عمال احاول ولم اصل

على العموم دى فكرة بسرعة ☺️ تم تعديل المرفق لتلافى مشكلة عدم وجود صوت ضمن اعدادت الويندوز Waiting Role.zip

الحمد لله رب العالمين ...... حياك الله

السلام عليكم هل هذا ما تريد اتفضل اخى جرب ووافنا بالنتيجه Private Sub ÃãÑ19_Click() Dim LastValue As Currency Dim LastID As Integer LastValue = Me.IDX LastID = Me.ID DoCmd.GoToRecord , , acNewRec Me.IDX = LastValue + 0.1 Me.OrderBy = "IDX" DoCmd.FindRecord LastID, , True, , True End Sub بالتوفيق book0001.accdb

بارك الله بك و نفع بعلمك

تفضل .... القسمة على غير العدد.accdb

السلام عليكم ورحمة الله وبركاته مرفق الملف مرة أخرى مع الحل لمن أراد الإستفادة . مع كامل الشكر والتقدير للأخ الفاضل خيماوي كووول على اهتمامه ومجهوده . جزاه الله كل خير وزاده علما . UP.xlsb

تفضل: A: iIf (Len(strFileNames & "") = 0;0;strFileNames) جعفر

واياكم اخى بالتوفيق

الله يجزيك الخير

السلام عليكم اتفضل استاذ @عبد اللطيف سلوم هل هذا ما تريد بالتوفيق ان شاء الله اوفسنا النشاش.accdb

وعليكم السلام 🙂 رجاء اعطاء تصور عن المطلوب ، فطرق العرض كثيرة 🙂 جعفر

السلام عليكم ورحمة الله وبركاته اثراء الموضوع .. في حال اضافة شيت بسمى اخر .. من ضمن مسميات جهة العمل .. يمكن العمل به .. ملف بيانات العاملين(1).xlsm

اذا كان لا بد من الكود Option Explicit Sub My_code() With Range("D2").Resize(, 2) Select Case True Case Range("C2") = vbNullString .Formula = "=SUMPRODUCT(($B$5:$B$50<=MAX($A$2:$B$2))*($B$5:$B$50>=MIN($A$2:$B$2))*D$5:D$50)" Case Else .Formula = "=SUMPRODUCT(($B$5:$B$50<=MAX($A$2:$B$2))*($B$5:$B$50>=MIN($A$2:$B$2))*($C$5:$C$50=$C$2)*D$5:D$50)" End Select .Value = .Value End With End Sub

وعليكم السلام 🙂 . . ثم في حدث عند تنسيق قسم التفصيل Detail من التقرير ، نضع هذا الكود الذي يخفي الحقل الفارغ ويجعل ارتفاعه = صفر اذا كان الحقل فارغ ، وإلا فيتركه كما هو : Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) On Error Resume Next Dim ctl As Control Dim txt As String Dim lbl As String For Each ctl In Me.Controls If ctl.ControlType = acComboBox Then txt = ctl.Name lbl = ctl.Name & "_تسمية" If Me(txt).Text = "" Then ctl.Visible = False ctl.Height = 0 Me(lbl).Visible = False Me(lbl).Height = 0 Else ctl.Visible = True ctl.Height = 0.2188 * 1440 Me(lbl).Visible = True Me(lbl).Height = 0.2188 * 1440 End If End If Next End Sub . والنتيجة . جعفر 1314.الجدولي اليومي.accdb.zip

وعليكم السلام ورحمة الله وبركاته تم تغيير المسميات من تشرين الى T2020 و كانون اول الى K2020 .. تم وضع زر لنسخ المطلوب ووضعه في الاكسل الاخر .. T2020 افتح الملفين K2020.xlsm T2020.xlsm

المعادلة في الصورة تكتب و تسحب يساراً

في الخلية J2 هذه المعادلة (Ctrl+Shift+Enter) =SUM(IF(MOD(ROW(J$6:J$1000),2)=1,J$6:J$1000,0)) في الخلية J3 استدبل الرقم 1 بالرقم 0 (Ctrl+Shift+Enter) =SUM(IF(MOD(ROW(J$6:J$1000),2)=0,J$6:J$1000,0)) و الان ضع التنسيق الشرطي الذي تريده

1- لا تقم بالترقيم لأنة يدرج اوتوماتيكياُ في كل صف (عندما تمتلىء كل الخلايا) 2- اكتب ما تريد في الجدول بما فيه الخلية الخضراء 3- عند الانتهاء اضغط الزر Run Sub Auto_sum() Dim Rg As Range Dim Mmax% Dim ro% ro = Cells(Rows.Count, 1).End(3).Row Mmax = Application.Max(Range("A2:A" & ro)) + 3 Cells(Mmax - 1, 2).Resize(, 5).Interior.ColorIndex = xlNone With Cells(Mmax, "F") .Formula = "=SUM(F3:F" & Mmax - 1 & ")" .Value = "My_Sum : " & .Value .Interior.ColorIndex = 35 End With End Sub Summation.xlsm

اتفضل بعد التجربة والتأكد من ان هذا مرادك انقل كل شئ الى قاعدتك ونفذ الاتى 1- التأكد من ادخال ip الخاص بالجهاز الرئيسى على الشكة فى الجدول tblSecurityIP 2- اجعل النموذج frmChkCon نموذج فرعى فى اى نموذج تحب لاغلاق القاعدة عند فقد الاتصال ب ip الجهاز الرئيسى على الشكة TestConnect.accdb

تفضل التعديل اخي الكريم مثال_للرسائل_عند_عداد_الوقت.zip

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

وممكن تجرب هذا الملف فبمجرد الضغط دبل كليك على اى خلية من العمود الأول A ويكون بداية من الصف السادس سيظهر لك الفورم مباشرة كل عام وانتم بخير ورمضان مبارك Search.xlsm