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

السلام عليكم ورحمة الله وبركاته انا احد الاشخاص الذين لا يحبذ ان يستعمل الكود في تخفيف أمان الاكسس ، فقد وضعته شركة مايكروسوفت في حزمة الاوفيس حتى تحمينا من ايدي المخربين ، وفي هذا الرابط شرحت كيفية عمل مجلد موثوق به للأكسس 2007 فما فوق: http://www.officena.net/ib/topic/66450-دمج-ملف-وتشغيله-قبل-أو-مع-بدء-اكسس/#comment-432363 المشكلة في كود تخفيف الامان ، انه لا يخفض مستوى أمان الاكسس لبرنامجك فقط ، وانما يخفض مستوى أمان جميع برامج الاكسس. ولكننا كمبرمجين لدينا مشكلتنا ، في انه اذا ارسلت برنامجك الى شخص ما ، فلا بد من التواصل معه و اعطاؤه الخطوات كما في الرابط ، وإلا فالبرنامج لن يعمل ، لان البرنامج يشتمل على الماكرو والوحدات النمطية. هنا اقدم لكم طريقة لجعل برنامجي فقط يعمل بمستوى أمان أقل ، فلا تظهر لي رسالة الأمان من الاكسس. العمل كله يدور حول كود ، ويجب حفظ الكود هذا في ملف بصيغة vbs ، والذي يجب ان نفتح برنامجنا عن طريقه. الكود يعمل على برامج الاكسس بصيغة mdb و accdb ، والمفروض ان يعمل على جميع اصدارات الاكسس 2003 فما فوق ، وعلى الاكسس 32بت و64بت (انا هنا اطلب من الشباب تجربته بإصدارات الاكسس التي يعملون عليها ، وإخبارنا بالنتيجة لوسمحتوا). اليكم طريقة العمل (رجاء انزال المرفق وفكه في المسار C:\jj ، وذلك حتى يمكنكم متابعة خطواتي): رجاء وضع البرنامج المرفق Seq.mdb حسب المسار التالي: C:\jj\Seq.mdb الآن اذهب الى المجلد C:\jj وافتح البرنامج Seq.mdb بالنقر المزدوج ، عند فتحه نرى رسالة أمان الاكسس ، وهذا متوقع ، وذلك بسبب انه في مجلد غير موثوق به (رجاء لا تضف هذا المجلد كمجلد أمان ، وانما اخرج من البرنامج). . الملف الآخر المرفق Seq.vbs ، يحتوي على هذا الكود: rem http://www.accessmvp.com/jconrad/accessjunkie/macrosecurity.html rem expression.OpenCurrentDatabase(filepath required, Exclusive optional, bstrPassword optional) dim o set o=createobject ("Access.Application") o.automationsecurity=1 ' set macro security LOW. o.opencurrentdatabase "C:\jj\Seq.mdb" o.usercontrol=true set o=nothing . تستطيع ان تجعله في اي مجلد (ممكن تجرب نسخه منه في اي مجلد شئت) ، وانقر مرتين على هذا الملف بُغية تشغيله ، سترى انه فتح البرنامج Seq.mdb ، وبدون رسالة أمان الاكسس ، وهو المطلوب ------------------------------------------------------------------------------------------------------------------------------------------- هذه الخطوة إضافية ، وهي لتحويل الملف السابق من صيغة vbs الى exe ، واختيار ايقونه للملف الجديد الآن ننتقل للخطوة التالية ، وهي ، اننا لا نريد ان ايقونة vbs ، وانما نريد ايقونه خاصة لبرنامجنا. هناك طريقتين: 1. ايقونة مختصر البرنامج Shortcut: وهي ان نعمل مختصر لملف Seq.vbs ، ولكن وللأسف مختصر ملف vbs يعطينا نفس ايقونة الملف نفسه ، وما عندنا طريقة لتغييرها!! لذلك ، سنعمل مختصر لملف الاكسس ، ونغير البيانات كالصورة التاليه ، بحيث يصبح مختصر ملف vbs يحتوي على ايقونة ملف الاكسس (طبعا يمكنك ان تغير الايقونة الى اي شئ شئت): . . . . وبهذه الطريقة غيّرنا ايقونة برنامج vbs الى ايقونه اخرى مناسبة 2. تحويل ملف vbs الى ملف تنفيذي exe ، وتختار له الايقونة التي تعجبك: رجاء انزال البرنامج المجاني Vbs to Exe من الرابط التالي: http://www.f2ko.de/en/v2e.php احد اسباب اختياري لهذا البرنامج ، اننا نستطيع التحكم به عن طريق Commandline ايضا ثم نتبع الخطوات التالية: ونستطيع ان نعمل لبرنامج vbs هذا كلمة سر كذلك ، . في الخطوة 6 تستطيع ان تكتب معلومات شركتك ، ونختار الايقونه التي نريدها للبرنامج (الخطوة 5) . . وتستطيع ان تجعله على سطح مكتب كمبيوترك الميزة في هذه الطريقة ، ان المستخدم لن يعرف مكان برنامج قاعدة البيانات Seq.mdb ، ولن يعرف الكود الذي كان في Seq.vbs ارجو ممن يضع ردا على الموضوع ، ان يذكر: 1. اذا اشتغل البرنامج على كمبيوتره ، 2. نسخة الاكسس التي يستخدمها. ملاحظة: الظاهر ان بعض متصفحات الانترنت حجبت انزال المرفق Seq.zip ، وذلك بسبب احتوائه على ملف vbs ، والذي يستخدمه الكثيرون لتخريب الكمبيوتر ، لذلك ، ارفق لكم Seq_2.zip والذي يحتوي على نفس ملفات Seq.zip ، ولكني غيرت صيغة الملف Seq.vbs الى Seq.txt . بعد انزال المرفق وفك ملفاته في الكمبيوتر ، رجاء تغيير مسمى الملف Seq.txt الى Seq.vbs جعفر Seq.zip Seq_2.zip

السلام عليكم ورحمة الله وبركاتة استخراج رقم الربع السنوى من تاريخ باستخدام ((معادلات)) الاكسيل لاتنسونا بصالح دعاؤكم المعادلات المستخدمه =CEILING(MONTH(A2)/3;1) =VLOOKUP(MONTH(A2);{1,1;2,1;3,1;4,2;5,2;6,2;7,3;8,3;9,3;10,4;11,4;12,4};2;0) =LOOKUP(MONTH(A2);{1;4;7;10};{1;2;3;4}) =ROUNDUP(MONTH(A2)/3;0) =CHOOSE(MONTH(A2);1;1;1;2;2;2;3;3;3;4;4;4) QUR.rar

طبعا ممكن اجعل كود استدعاء الفورم كالاتى Sub النتائج() Dim x As Variant x = InputBox("أدخل كلمة المرور لفتح الفورم") If x = "" Then Exit Sub If x = "123" Then UserForm1.Show Else MsgBox ("كلمة المرور غير صحيحة") End If End Sub

أخى سعيد أخى ياسر هذا كود آخر بالحلقات التكرارية صحيح أنها تكون بطيئة قليلا فى البيانات الكبيرة ولكن وضعتها لاثراء الموضوع Sub ragab() Dim cl As Range, cll As Range Dim LR1 As Integer, LR2 As Integer Dim sh1 As Worksheet, sh2 As Worksheet '======================================== Set sh1 = Sheet1: Set sh2 = Sheet2 LR1 = sh1.Range("A10000").End(xlUp).Row LR2 = sh2.Range("A10000").End(xlUp).Row sh1.Range("E8:E" & LR1).ClearContents '======================================== For Each cll In sh2.Range("C8:C" & LR1) For Each cl In sh1.Range("B8:B" & LR1) If cll = cl Then cl.Offset(0, 3) = cll.Offset(0, 6) End If Next Next End Sub

أخي الكريم سعيد جرب الكود التالي Sub TransferMatchingItems() Dim Ws As Worksheet, Sh As Worksheet, Cel As Range, Found Set Ws = Sheet2: Set Sh = Sheet1 Application.ScreenUpdating = False With Sh For Each Cel In .Range("B8:B" & .Cells(Rows.Count, "B").End(xlUp).Row) Set Found = Ws.Range("C:C").Find(What:=Cel.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not Found Is Nothing And Not IsEmpty(Cel.Value) Then Cel.Offset(, 3).Value = Found.Offset(, 6).Value End If Next Cel End With Application.ScreenUpdating = True End Sub تقبل تحياتي

جزيت خيراً حاول كما أخبرتك أن تدعم شروحاتك بملفات ليستفيد منها الجميع تقبل الله منا ومنكم صالح الأعمال وإليك فيديو يقوم بالأمر

أخي الكريم أحمد خبرتي ضعيفة في هذا الخصوص نظراً لأنني لم أقم بمشاركة مصنف من قبل .. جرب الكود التالي وهو أحد روائع أخونا الغائب عن العين الحاضر في القلب أبو تراب غفر الله لي وله Sub SharedFile() With ActiveWorkbook Application.DisplayAlerts = False .ExclusiveAccess Application.DisplayAlerts = True ActiveSheet.Unprotect 1 'ضع أكوادك ها هنا ActiveSheet.Protect 1 Application.DisplayAlerts = False .KeepChangeHistory = True .SaveAs Filename:=ActiveWorkbook.FullName, AccessMode:=xlShared Application.DisplayAlerts = True End With End Sub إن شاء الله يحل المشكلة بالنسبة للمصنف المشترك .. تقبل تحياتي

تفضل جعفر 250توزيع استعلام جدولي2003.zip

السلام عليكم ورحمة الله وبركاته الاصدار الرابع : فورم اضافة وبحث وتعديل مرن مع استعراض الصور (تحكم كامل بالصورة ) المرفق 2003 فورم ادخال و تعديل مرن مع الصور.rar http://www.officena.net/team/khboor/kh_image/p86.png هام جدا بتاريخ ( 14 / 6 / 2023 ) لكي يعمل الفورم جيدا بدون اخطاء لابد من عمل الاتي 1- UnRegister MSCOMCT2.OCX ازاله تسجيل الملف MSCOMCT2.OCX تشغيل الامر cmd كمسئول ثم كتابه الأمر التالي لو كان الويندوز ٦٤ بت regsvr32 /u C:\Windows\SysWOW64\MSCOMCT2.OCX او regsvr32 /u C:\Windows\System32\MSCOMCT2.OCX لو كان الويندوز ٣٢ ثم بفك الضغط عن الملف المرفق بأسم MSCOMCT2.OCX ونقوم بنسخه الي المسار التالي ويندوز٦٤ بت C:\Windows\SysWOW64 ويندوز ٣٢ بت C:\Windows\System32 2- Register MSCOMCT2.OCX ثم نقوم بعمل ريجستر للملف الذي نسخناه في الويندوز عن طريق هذا الأمر ويندوز ٦٤ regsvr32 C:\Windows\SysWOW64\MSCOMCT2.OCX ويندوز ٣٢ regsvr32 C:\Windows\Sys\MSCOMCT2.OCX MSCOMCT2.zip

السلام عليكم ورحمة الله وبركاته ****************** نويت بإذن الله تعالى - والله الموفق - أن أقوم بالبدء في هذا المشروع الكبير الذي أطلقت عليه اسم (مكتبة الصرح .. زاخرة بالشرح) بحثت عن ملف الأستاذ الكبير عبد الله باقشير (محفظة الأكواد) للعمل عليه .. ** رجاء من الأخ عبد الله .. إضافة للفورم في هذا الملف أن تكون عملية البحث غير مقتصرة على عناوين الأكواد فقط ، بل تشمل عمليه البحث الـ ListBox الذي يحوي الأكواد نفسها ، وكذلك صفحة التعليمات ، حتى يسهل فيما بعد على الباحث أن يصل لمراده بسهولة .. الأمر مختلف قليلاً عما قدم من قبل ، إذ أن الأكواد ستكون مصحوبة بالشرح (على قدر استطاعتي ) ولمن أراد أن يزيد على الشرح فليفعل ولا يتردد.. من هنا بإذن الله ستكون الإنطلاقة الكبرى نحو المشروع الكبير .. وسأحاول جاهداً أن أبدأ عملية بناء المكتبة بشكل منظم يسهل على الباحث فيما بعد الوصول للكود الذي يرغبه ، ويعرف كيف يقوم بتطبيق الكود بنفسه دون الحاجة لغيره .. يعني مبدأ الاعتماد على النفس في تطبيق الأكواد.. وإليكم الملف المرفق به 5 أكواد فقط مدعومة بالشرح منها 3 اكواد بسيطة ، وكود صعب قليلا ، ودالة معرفة UDF كنقطة بداية .. ملحوظة الأكواد مدعومة بالشرح في صفحة التعليمات . أرجو أن ينال رضاكم ... ولا تنسوا التصحيح والتنقيح إخواني أولاً بأول ، حتى يخرج العمل في النهاية بشكل لائق يليق بمنتدانا .. يليق بالصرح العملاق ولذا أسميت المشروع (مكتبة الصرح والصرح المقصود به منتدانا الغالي .. وإن شاء الله تكون المكتبة زاخرة وممتلئة بالشرح بعون الله وتوفيقه ثم بجهودكم ومساندتكم للمشروع) Codes Library.rar

الصورة تشير إلى أن المتغير غير معرف أي لم يتم تعريفه في بداية الكود ضع اسم المتغير بعد كلمة Dim ثم كلمة As ثم نوع المتغير أي بهذا الشكل Dim Sh as long طالما أنك ستقوم بعد الخلايا التي تحتوي نصوص إذاً فالعدد صحيح فيمكن الإعلان عنه من النوع Interger أو النوع Long ..

أخى الحبيب ياسر قمت بتحديد الخلايا من A3 الى A29 مرة واحدة ثم وضعت المعادلة فى شريط الصيغة ثم ضغط ctrl + enter

هل يوجد أسماء دوائر لا توجد لا هنا ولا هنا ..لا في دائرة البنين ولا في دائرة البنات ؟؟ حيث أنني أقوم ببعض المحاولات ولكن عدد النتائج لكلا التقريرين يساوي 178 فقط ..بينما الدوائر في الورقة الأولى تساوي 270 وعدد الدوائر الموجودة في كلا الورقتين بنين وبنات يساوي 203 .. تقبل تحياتي

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

جرب هذا الملف تاريخ تلقائي SALIM.rar

أخى حمادة جرب المرفق ترحيل بيانات1.rar

هذا يعني أنك تحتاج لتقريرين وليس لتقرير واحد ..تقرير للبنين وآخر للبنات ...؟؟

المهندس الفاضل / محمد طاهر ما زالت المشكلة موجودة

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

وعليكم السلام انا عملت 1-5 ، ولم افهم الطلب 6 ، واعتقد بأنك تستطيع ان تعمله على المرفق ان شاء الله انا قمت بتغيير التواريخ قليلا ، حتى ارى الفرق اساس العمل كله هو هذا الاستعلام . لاحظ التاريخ الذي ساجربه اولا . العمل كله يتم عن طريق هذا النموذج . هذه نتيجة بيانات النموذج . فيكون الرسم البياني ، والذي اساسه الاستعلام اعلاه . بينما اذا غيرنا بيانات النموذج . فالنتيجة . . والان سأشرح لك طريقتي في عمل الرسومات البيانية . الخطوات التالية ، كله اضغط على Next .. Next .. واخيرا Finish ، وبدون ان اهتم بالتفاصيل . والنتيجة . عندها ابدأ العمل الفعلي ، وهو بتغيير Row Source . واخترت الاستعلام اللي عملته في البداية . والنتيجة . واذا اردت ان اغير في الحقول ، اضغط على الزر اللي في الدائرة الحمراء ، والدخول الى الاستعلام ، وتغيير الحقول كما اشاء واذا اردت تغييرات اخرى ، انقر مرتين على الرسم البياني جعفر 251.Database3.accdb.zip

أخى حماده عندما يتم الترحيل الى صفحة D يتم ذلك فى السطر السابع ( تمام كدا ) وفى الترحيل التالى سوف يتم فى السطر الثامن وهكذا الى أن نصل الى السطر 15 ولكن عند الترحيل بعد ذلك ( أين يتم الترحيل ) علما بأن السطر 16 به معادلات كما تقول أرجو التوضيح

تفضل أخى علما بان اسم المستخدم ragab وكلمة المرور 123 ويمكنك تغيرهما من الخلايا A1 و A2 من الصفحة الأولى Book1.rar تفضل أخى علما بان اسم المستخدم ragab وكلمة المرور 123 ويمكنك تغيرهما من الخلايا A1 و A2 من الصفحة الأولى Book1.rar

ابعث المرفق وسوف الاصدقاء المنتدى يساعدونك ان شاء الله في الطريقة الصحيحة

السلام عليكم تم عمل بعض التعديلات على السيرفر برجاء الافادة اذا ما زالت المشكلة مستمرة

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

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

أخي الحبيب رجب جاويش وأخي الغالي مختار بارك الله فيكما وجزاكما الله خيرأً إليكم هذا الحل إثراءً للموضوع ..الحل معقد بعض الشيء لكنه يلبي الغرض من ناحية إظهار كلمة السر على شكل نجوم أولاً يتم إدراج موديول من النوع Class باسم PwdInputBox ويوضع فيه الكود التالي Function PassInputBox(Prompt As String, Optional PasswordChar As String, Optional Title As String, Optional Default As String, Optional XPos As Long, Optional YPos As Long) Dim UF Dim VUF As Object Dim Lb As Object Dim Tb As Object Dim BOk As Object Dim BCancel As Object Dim VBAVisible As Boolean Dim I As Integer If Len(Title) = 0 Then Title = Application.Name VBAVisible = Application.VBE.MainWindow.Visible Application.VBE.MainWindow.Visible = False Set UF = ThisWorkbook.VBProject.VBComponents.Add(3) Set Tb = UF.Designer.Controls.Add("Forms.Textbox.1", "TextBox1") With Tb .PasswordChar = PasswordChar .Left = 4.5 .Top = 69.75 .Width = 254.25 .Height = 15.75 .Value = Default End With Set Lb = UF.Designer.Controls.Add("Forms.Label.1") With Lb .Caption = Prompt .WordWrap = True .Left = 6.75 .Top = 6.75 .Width = 198 .Height = 54 End With Set BOk = UF.Designer.Controls.Add("Forms.CommandButton.1", "BOk") With BOk .Caption = "OK" .Left = 209.25 .Top = 4.5 .Width = 49.5 .Height = 18 .Default = True End With Set BCancel = UF.Designer.Controls.Add("Forms.CommandButton.1", "BCancel") With BCancel .Caption = "Cancel" .Cancel = True .Left = 209.25 .Top = 27 .Width = 49.5 .Height = 18 End With With UF.CodeModule I = .CountOfLines .InsertLines I + 0, "Public MyText as Variant" .InsertLines I + 1, "Private Sub BCancel_Click()" .InsertLines I + 2, " MyText = False: Me.Hide" .InsertLines I + 3, "End Sub" .InsertLines I + 4, "Private Sub BOk_Click()" .InsertLines I + 5, " MyText = TextBox1.Value: Me.Hide" .InsertLines I + 6, "End Sub" .InsertLines I + 7, "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)" .InsertLines I + 8, " If CloseMode = 0 Then Cancel = True: MyText = False: Me.Hide" .InsertLines I + 9, "End Sub" End With With UF .Properties("Caption") = Title .Properties("Width") = 273 .Properties("Height") = 108.75 If XPos > 0 Or YPos > 0 Then .Properties("StartUpPosition") = 0 .Properties("Left") = XPos .Properties("Top") = YPos Else .Properties("StartUpPosition") = 1 End If End With Set VUF = VBA.UserForms.Add(UF.Name) VUF.Show PassInputBox = VUF.MyText ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=UF Application.VBE.MainWindow.Visible = VBAVisible End Function ثم يتم إدراج الكود التالي في موديول عادي .. Sub ShowForm() Dim ANS As Variant Dim App As PwdInputBox Set App = New PwdInputBox ANS = App.PassInputBox("Please Enter The Password", "*", "My Application") If ANS = False Or ANS = "" Then Exit Sub Else If ANS = "123" Then UserForm1.Show Else MsgBox "Incorrect Password", vbCritical End If End Sub وإليكم المرفق فيه تطبيق ما سبق تقبلوا تحياتي Show UserForm By Password Mask For InputBox YasserKhalil.rar

جرب هذا الكود لو اردت ان تبقى القيمة في الخلايا A1 & C1 امسح السطر السادس من الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Or Target.Address = "$C$1" Then Application.EnableEvents = False x = Target.Value Range("b2") = x Target.Value = "" End If Application.EnableEvents = True End Sub

جرب المعادلة التالية =IF(B1<>"",B1,IF(A1<>"",A1,"")) يرجى تغيير اسم الظهور للغة العربية تقبل تحياتي

سلام عليكم نعم تستطيع العمل ذلك وهذا بانشاء تقرير عن طريق استعلام المراد البحث عن اسم( سجل9) ثم تقوم export ver word فقط وتضهر التسجيلة في الوود

ان داله sumproduct لها استخدامات كثيره و مهام تغنيك عن استخدام الكثير من الدوال فانها ليست مجرد داله للجمع او الضرب والان نقوم بسرد بعض هذه المهامواطلب من الجميع المشاركه واضافه مهام اخرى1- تستخدم فى العمليات الرياضيه ( جمع - طرح - ضرب - قسمه)2- تستخدم فى عمليات الجمع الشرطى والجمع الشرطى المتعدد 3- تستخدم فى عمليات العد كبديل للداله count 4- تستخدم كبديل للداله vlookup بشرط ان يكون ناتج البحث رقم و ليس نص 5-لاغنى عنها فى اعداد الحسابات و القوائم الماليه

يمكن وضع مسافة قبل المعادلة أو علامة التنصيص المنفردة ' ..

فى بعض الاحيان نقوم بعمل فلترلعمود معين او اخفاء لبعض الصفوف ونريد عمل نسخ للخلايا المرئيه فقط ولكن عندما نقوم بعمل لصق يتم لصق جميع الخلايا المرئيه و المخفيه و لكى نتغلب على هذه المشكله نقوم بتحديد الخلايا المرئيه فقط باتباع الخطوات الاتينضغط على F5 سيظهر لنا مربع GO TO نضغط على special ثم visible cells ثم okبهذا سيتم تحديد الخلايا المرئيه فقط نقوم بنسخها ولصقها فى اى مكان نريده

طريقه لاخفاء محتويات الخلايا و جعلها لاتظهر دون الحاجه الى اخفاء الصف او العامودلإخفاء البيانات قم بتحديدها أولاً، ثم أذهب home->font ثم ستجد سهم صغير فى الركن الأيمن السفلى أضغط عليه ثم أختار نافذة number->custom ثم أكتب (;;;)، ستجد أن البيانات قد أختفت ولكنها تظهر فى نافذة العرض بجوار زر function

وعليكم السلام اخى ياسر بارك الله فيك مرفق الشيت الخاص بالموضوع sumproduct.rar

بارك الله فيك وإليك فيديو فيه شرح لكيفية إخفاء محتويات الخلايا أرجو أن ينال إعجاب الجميع تقبلوا تحياتي

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

عند استخدام احد دوال البحث مثل Vlookup و Hlookup ينبغى ان يكون الشئ المراد البحث عنه مكتوب بنفس الطريقه التى فى الجدول الاخر و لتفادى مشكله رسائل الخطا فى دوال البحث يمكن اتباع الاتى 1-اذا كان المراد البحث عن اسم معين مثل اسم عميل او موظف يستحسن البحث عنه بكوده وليس اسمه 2-استخدام القوائم المنسدله 3استعمال داله IFERROR 4- تثبيت الجدول الذى نبحث فيه باستخدام F4 5-لابد ان يكون الشئ الذى نبحث عنه فى اول عمود بالجدول الذى نبحث فيه

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

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

سؤال أخي أبو يوسف طالما أن البحث في ورقتي عمل : هل يمكن أن يكون هناك نتيجة للبحث في كلتا الورقتين معاً ؟ وما العمل في هذه الحالة ؟كيف تريد شكل المعلومات التي يتم جلبها ؟

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

بعد اذن اخواني في المنتدى هذا الكود البسيط الذي يعكس كل شيء (ارقام ونصوص) معادلة عكس الارقام salim.rar Function RevText(s As String) If Len(s) = 1 Then RevText = s Else RevText = RevText(Mid(s, 2, 99)) & Left(s, 1) End If End Function

الحلقة الرابعة عشر ***************** السلام عليكم ورحمة الله وبركاته وحشتكم !! أكيد لا .. لأني لو وحشتكم كنتو فتحتوا الباب وسألتوا عليا .. عموما إنتو وحشتوني ، وعشان وحشتوني هاقدم لكم حلقة جديدة يمكن تفتكروني. النهاردة هتكلم عن حاجة ناس كتير شرحوها ، وشرحوها بشكل ممتاز ، ودا خلاني مش عارف أشرح إزاي ، لأن اللي شرحوها وفوا شرحها صراحة .. هنتكلم عن الحلقات (بس مش حلقات افتح الباب) الحلقات اللي هنتكلم عنها الحلقات التكرارية ، ومن اسمها هي عبارة عن حلقات بتتكرر (إضافة عظيمة!) اسمها بالإنجليزي Loops ودي مهمة جداً في عالم الأكواد ، محدش يقدر يستغنى عنها تقريباً .. نفترض إني دخلت الفصل (بما إني معلم) ولسه دي أول مرة أتعرف على الطلبة اللي في الفصل ..يا ترى أنا عندي استعداد أخلى طالب طالب يقوم وأنا أقوله قول اسمك والطالب اللي بعديه قول اسمك .. أعتقد إن ريقي هينشف ودماغي هتصدع ودا طبعا مش يرضيكم (مش كدا ولا ايه) ..أنا من النوع الكسول فكل اللي هعمله هعمل تكرار من أول طالب في الفصل لآخر طالب ، وأعطي الأمر مرة واحدة .. من أول طالب إلى آخر طالب قووووول اسمك يا حبيبي الطالب التالي هو دا شكل الحلقة التكرارية .. نبرمجها بلغة الـ VBA ... هنقول إن الفصل فيه 60 طالب (معلش دا واقع الفصول في مصر) .. نقطة مهمة مننساش إن الطالب متغير مش ثابت ، فنرمز للطالب المتغير بالرمز X مثلاً ... Sub Loops() Dim X As Long For X = 1 To 60 'Say your name Next X End Sub طبعاً الكود دا شوية له علاقة بالبرمجة وشوية هتش .. ايه اللي هنعمله ..زي ما اتعودنا (دايما) إننا نعرف المتغير .. ونركز في السطر الثاني بدأ بكلمة For متبوعة باسم المتغير اللي هو X وبعدين علامة يساوي عشان نحدد قيمة X المتغيرة (أو الطالب المتغير) وهنا القيمة ليها بداية وليها نهاية (كل شيء له بداية ونهاية) وبيفصل بين البداية والنهاية حرف الجر To وفي آخر الحلقة التكرارية جملة Next X وممكن نقول Next ونسكت ، ومحرر الأكواد هيفهم لوحده .. بس أنا تقليدي شويتين فخلينا نكتب المتغير ، عشان الكود ممكن يكون فيه أكتر من حلقة تكرارية .. الجزء المهم هو الجزء اللي بين السطرين ، وهو دا الأمر المطلوب تكراره ، السطر اللي هنا مجرد تعليق وهتش وملوش علاقة بالبرمجة .. بس حبيت أقرب لكم الفكرة بأسلوب جديد.. كدا لما أنفذ الكود اللي فات ، كل اللي عملته إني أعطيت الأمر مرة واحدة وبس (وأنا حاطط رجل على رجل ... الدورة تلف على طالب طالب ، ويقول اسمه ، ولما يخلص ، الدورة تنتقل للطالب اللي بعديه وهكذا إلى أن ينتهي الطلاب ، ولما الـ 60 طالب يخلصوا ..يتم إيقاف تنفيذ الكود... ناخد أول مثال بجد عشان نقدر نتعلم إزاي نستفيد من الحلقات التكرارية :: لنفترض أننا عايزين نرقم النطاق A1:A10 بالأرقام من 1 إلى 10يعني الخلية A1 = 1 والخلية A2=2 وهكذا ..طبعا الموضوع بسيط جدا Sub NumberRange() Range("A1").Value = 1 Range("A2").Value = 2 Range("A3").Value = 3 Range("A4").Value = 4 Range("A5").Value = 5 Range("A6").Value = 6 Range("A7").Value = 7 Range("A8").Value = 8 Range("A9").Value = 9 Range("A10").Value = 10 End Sub كود في منتهى الروعة .. شايف حسام بيضحك ويقولي عايزك ترقم النطاق من A1:A100 (وابتسم ابتسامة فيها شماته !!) نفكر شوية .. بقول نفكر شوية (بلاش تكمل الحلقة غير لما تبص في الكود وتفكر شوية .. فكر شوية واكسب التوفير في الوقت والجهد) ايه المشترك في أسطر الكود .. وايه المختلف .. المتشابه في كل الأسطر Range("A ").Value = والمختلف هو الرقم بعد حرف الـ A ، والقيمة اللي بعد علامة يساوي .. في السطر الأول الرقم اللي بعد حرف الـ A هو 1 ، والقيمة بعد علامة يساوي بردو 1 ، ونفس الكلام مع السطر رقم 2 ، ورقم 3 وهكذا يبقا أول حاجة تفكر فيها إنك المختلف أو المتغير أو الشيء الغير ثابت تضعه في متغير ، ودا لأنه مش ثابت ومتغير .. فنضع متغير باسم X مثلاً ونعمل حلقة تكرارية من 1 إلى 10 (دي القيم اللي هيحملها المتغير) Sub NumberRange() Dim X As Long For X = 1 To 10 Range("A" & X).Value = X Next X End Sub نفس الكود اللي شرحناه من شوية ، الاختلاف في السطر اللي بين سطري التكرار .. الحلقة هتدور 10 مرات ، وفي كل مرة المتغير X بيحمل قيمة مختلفة (نرررررركز في الجزئية اللي جاية لأنها مهمة جداً جداً ) مش هنفذ الكود مرة واحدة .. سنقوم بعملية التنفيذ واحدة واحدة ، اللي مستعجل يروح ينفذ الكود مرة واحدة ، واللي مش مستعجل أنا معاه ..عشان يعرف حاجة مش هيعرفها الأخ المستعجل ... ضع مؤشر الماوس في أي مكان في الكود .. جميل >> اضغط F8 من لوحة المفاتيح ، وجمد قلبك وقول يا رب .. لاحظت ايه يا عبد المحسن؟ عبد المحسن ناااااااام مني (الله يسامحك) ..عبد المحسن : شايف الدنيا صفرا ليه ، هو فيه عاصفة النهاردة كمان؟ .. رديت عليه : لا يا عبد المحسن كمل نومك ، السطر الأصفر اللي ظهر ده سببه إننا ضغطنا F8 .. ودا فايدته إننا هنقوم بعملية التنفيذ واحدة واحدة .. سطر سطر .. السطر الأصفر على أول سطر في الكود Sub NumberRange() اضغط F8 مرة تانية ، ايه اللي حصل انتقل السطر الأصفر للسطر التالت ، طيب والسطر التاني يا معلم .. ملوش لازمة !!! أكبر خطأ إنك تعتقد إنه ملوش لازمة ، لما ضغطنا F8 للمرة التانية ، محرر الأكواد خزن في الذاكرة كل المتغيرات الموجودة في الكود عايز تتأكد من كلامي ، حرك مؤشر الماوس اللي على شكل حرف I (فيه شرطة فوق وشرطة تحت) حرك الماوس من غير ما تدوس كليك .. واقف على المتغير X هتلاقي تلميح في مستطيل صغير بيقولك المتغير X=0 ، دي كدا القيمة المبدئية للمتغير ... لما تضغط F8 للمرة التالتة ، روح شوف قيمة X مرة تانية هتلاقي قيمة X=1 (ايه اللي خلاها 1 مش كانت صفر من لحظة ) اللي حصل إننا انتقلنا من السطر For X = 1 To 10 والسطر دا هيبدأ في عمل الحلقة التكرارية اللي بنقول عليها ، والحلقة بدايتها 1 زي ما حددنا (وطبعاً ممكن نغير نقطة البداية يا شباب .. مش شرط 1) حرك مؤشر الماوس من غير ما تدوس على المتغير X في السطر المظلل بالأصفر Range("A" & X).Value = X هنلاقي زي ما قلت إن X =1 يعني محرر الأكواد هيعمل ايه دلوقتي ، هيشيل كل X ويحط مكانه القيمة 1 ، فيصبح السطر في الذاكرة بهذا الشكل Range("A1").Value = 1 لحد كدا تمام التمام ، صغر محرر الأكواد بحيث تكون ورقة العمل ظاهرة بالنسبة لك واتأكد إن النطاق A1:A10 فارغ ليس به أي بيانات ، وركز في ورقة العمل ، واضغط F8 عشان تنقل السطر الأصفر إلى هذا السطر ، ولاحظ ورقة العمل Next X لاحظت يا منصور الخلية A1 وضعت فيها القيمة 1 ، نخلي بالنا إن السطر الأصفر بيتم تنفيذه بعد الخروج منه ، فلما خرجنا من السطر تم تنفيذ الأمر وأعطى القيمة 1 للخلية A1 .. اضغط F8 مرة أخرى ، ونلاحظ إن السطر الأصفر انتقل للسطر اللي قبليه ، مش لبداية الحلقة التكرارية ، يعني ببساطة السطر اللي بيحدد بداية الحلقة ونهايتها بيعدي عليه مرة واحدة فقط .. أما سطر الأمر والسطر اللي فيه كلمة Next بيبدل السطر الأصفر عليهم... نبص دلوقتي على قيمة المتغير X هنلاقيها بقت 2 فيتم تنفيذ السطر بمجرد الضغط على F8 ويضع القيمة 2 في الخلية A2 وهكذا ..جرب واضغط F8 وفي كل مرة شوف قيمة المتغير X وشوف النطاق A1:A10 في كل مرة أول ما توصل قيمة المتغير X إلى الرقم 10 تتوقف الحلقة التكرارية ، وينتقل السطر الأصفر لجملة End Sub .. وينتهي عمل الكود .. عارف إني طولت في النقطة اللي فاتت ، بس كان لازم أطول فيها ، عشان أنا فاضي ومفيش ورايا شغل ، فقلت أصدعكم شوية!! ننتقل لمثال آخر --------------- عشان نقدر نفهم إزاي نستفيد من الحلقات التكرارية .. عايزين نعد الاسم (أحمد) في النطاق A1:A10 نفترض إني عندي الأسماء دي في النطاق A1:A10 أحمد ياسر سليم حسام عيسى أحمد أحمد خليل عبد الله أحمد المطلوب : نشوف الاسم (أحمد) كم مرة تم تكراره .. المعطيات : استعن بالله ثم بالحلقة التكرارية .. الفكرة : هنعمل اختبار صغير بقاعدة IF وهنقول لو قيمة الخلية بتساوي "أحمد" .. زود المتغير Counter بقيمة واحد Sub CountName() Dim X As Long Dim Counter As Long For X = 1 To 10 If Range("A" & X).Value = "أحمد" Then Counter = Counter + 1 Next X MsgBox Counter End Sub عملنا متغير جديد باسم Counter عشان لما يتحقق الشرط ويلاقي الاسم "أحمد" يقوم يخلي المتغير Counter يساوي نفسه + 1 طيب ليه يساوي نفسه ، عشان في كل مرة يلاقي أحمد قيمته هتتغير فلازم نضيف واحد لكل Counter جديد النتيجة في الآخر هتظهر في رسالة ، وهي 4 .. طيب نجرب نشيل الواحد في هذا السطر Counter = Counter + 1 لو شيلنا الواحد هتكون النتيجة 0 ، لأن المتغير قيمته المبدئية صفر ، فلما يتحقق الشرط مش هيزيد المتغير إلا لما نضيف واحد في كل مرة يتحقق الشرط. هناخد مثال آخر ---------------- عندنا درجات في النطاق A6:A15 ، عايزين نكتب ناجح أوراسب في الخلية المجاورة للدرجة ، لو الدرجة أكبر من أو يساوي 50 يبقا ناجح ، مكانش يكون راسب ... نخلي بالنا أنا غيرت بداية النطاق عشان الحلقة التكرارية بردو هتتغير بدايتها ونهايتها طبقاً للصفوف الجديدة 58 41 88 40 50 40 98 94 60 35 نجرب الكود التالي .. Sub LoopsTest() Dim X As Long For X = 6 To 15 If Cells(X, 1).Value >= 50 Then Cells(X, 2).Value = "ناجح" Else Cells(X, 2).Value = "راسب" End If Next X End Sub نلاحظ الحلقة التكرارية بدأت من 6 إلى 15 (ودا متغير للصفوف من الصف رقم 6 إلى الصف رقم 15) ووضعنا الشرط بين سطري الحلقة التكرارية ، لو الخلية اللي في الصف X والعمود الأول أكبر من أو يساوي 50 يقوم يعمل ايه؟ يضع القيمة النصية "ناجح" في الخلية اللي في العمود الثاني والصف X (نفس الصف بالطبع لأن قيمة X في الحالة دي هي هي نفس القيمة لأننا في نفس اللفة) .. إذا لم يتحقق الشرط قام بتنفيذ الجزء الثاني بأن يكتب النص "راسب" ثم إغلاق جملة IF بالجملة End IF ومننساش القفلة زي ما اتعودنا.. ننتقل لآخر مثال في الحلقة دي (عشان أنا تعبت وإنتو كمان أكيد تعبتو) في الأمثلة اللي فاتت عملنا حلقات تكرارية للصفوف .. واحد بيقولي طيب والأعمدة ملهاش نصيب في الدوخة اللي إحنا فيها دي .. أقوله أكيد ليها نصيب .. المطلوب إننا في الصف الرابع ، نكتب معادلة =COLUMN() بس في الأعمدة من العمود رقم 1 إلى العمود رقم 15 (A To O) نعقدها شوية ونقول في الأعمدة اللي رقمها فردي بس (الأعمدة اللي رقمها زوجي مش محتاجينها) يعني ببساطة عايزين نحط المعادلة في الأعمدة A C E G I K M O Sub ColumnsLoop() Dim X As Long For X = 1 To 15 Step 2 Cells(4, X).Formula = "=COLUMN()" Next X End Sub الحلقة التكرارية بدأت من العمود الأول حتى العمود رقم 15 (البداية والنهاية) معلومة جديدة Step 2 (دي معناها إننا هنقفز ..والقفز هيكون بمقدار 2 أي خطوتين) بدأنا بـ 1 فلما نقفز بمقدار 2 ، هنروح لرقم 3 ، أي أن المتغير سيكون رقم فردي في كل مرة 1 ، 3 ، 5 ، 7 ، 9 ، 11 ، 13 ، 15 (وهو دا المطلوب بالضبط) سطر الأمر فيه الخاصية Formula ودي عشان نقدر نضع معادلة من خلالها .. والمعادلة ببساطة زي ما شفناها من شوية بس بتكون بين أقواس تنصيص .. طيب الجزء الأول من السطر نلاحظ إننا استخدمنا Cells ودي بتكون متبوعة بقوسين ، وبين القوسين رقم الصف ثم فاصلة ثم رقم العمود ، وبما إن رقم الصف ثابت اللي هو رقم 4 ، فكتبناه زي ما هو .. اما رقم العمود فمتغير فوضعنا رقم العمود X ... جرب الكود وشوف النتيجة بنفسك أرجو أن أكون قد وفقت في توصيل المعلومة بأسلوب مبسط كان معكم أخوكم أبو البراء من تراك أوفيسنا (لف على الحلقات من الحلقة رقم 1 إلى الحلقة رقم 14 .. لو عايز تتعلم الـ VBA) ويا رب ميكونش فيه حد جاله دووووووووخة من كتر اللف .. والله أنا اللي دوخت أستودعكم الله .. دمتم في رعاية الله تقبلوا تحياتي .. دمتم بود

لنبدأ على بركة الله مجموعة اكواد متنوعة تخص تغير عنوان التطبيق بطريقة مرنة 1- لإدراج إسم الفورم من بيانات المدرجة في العمود 1 , الصف 1 من الصفحة النشطة Private Sub UserForm_Initialize() UserForm1.Caption = ActiveSheet.Cells(1, 1) أو UserForm1.Caption = ActiveSheet.Range("A1") End Sub 2- لإدراج إدراج إسم افورم من إسم الورقة النشطة Private Sub UserForm_Initialize() UserForm1.Caption = ThisWorkbook.ActiveSheet.Name End Sub 3- إدراج إسم الفورم إختياري من أي ورقة تريدها مثلا الورقة 2 : الصف 1 ; العمود 2 Private Sub UserForm_Initialize() UserForm1.Caption = Sheets(2).Cells(1, 2) End Sub

تفضل المرفق 2003 ترتيب العشرة الاوائل حسب المجموع والعمر2.rar

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

السلام عليكم ورحمة الله أخي الكريم، لم أفهم عليك الملاحظة "خطوط قلب الارقام تعمل مع برنامج وورد" لأنه إذا تم تنصيب أي خط من الخطوط فتجدها تعمل مع أي برنامج في الويندوز... ونوع الخط الذي حضرته وسميته Inverse.ttf في ردي السابق قمت بتدوير حروف وأرقام ورموز الخط المعروف Times New Roman أفقيا ثم عموديا بزاوية 180 درجة (وهو الذي يريده أخونا أحمد في طلبه -على ما أعتقد-) بينما نوع الخط الذي اقترحته في ردك فهو يقوم بقلب الحروف والأرقام عموديا بزاوية 180 درجة... والله أعلم أخوك بن علية

السلام عليكم ورحمة الله أخي الكريم وهذا عمل آخر مختلف تماما عما سبق، قمت بتحضير نوع خط جديد سميته Inversed.ttf يقوم بقلب أي حرف أو رقم أو علامة بعد تطبيق هذا النوع عليها وتجد اسم الخط في قائمة الخطوط مقلوبا هو أيضا... في الملف المرفق تجد ملفين أحدهما هو نوع الخط يجب تنصيبه مع خطوط ويندوز والملف الثاني هو مثال تطبيقي على قلب الأرقام وقد استعملت معه دوال تقوم بكتابة الأرقام بالعكس (من اليمين إلى اليسار) (والحد الأعلى لأرقام العدد الذي تريد قلبه هو 6 أرقام)... أخوك بن علية قلب الأرقام بالخط.rar

اشكركم اخواني على التشجيع واليكم بعض الكودات المهمة في البرمجة الوظيفة <<==========================الكود اصدار صوت<<====================DoCmd.Beep اغلاق النموذج او التقرير<<=============DoCmd.Close تكبير النموذج او التقرير<<===========DoCmd.Maximize تصغير النموذج او التقرير<<===========DoCmd.Minimize الخروج النهائي من قاعدة البيانات<<========DoCmd.Quit