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

بسم الله الرحمن الرحيم Formula To VBA ضع الماوس على الخلية التي يوجد فيها معادلة معينة وإضغط على بسم الله ستظهر لديك المعادلة محولة و جاهزة للنسخ , قم بنسخها ثم قم بوضعها داخل كود أخونا الكريم عبد الله باقشير جزاه الله خيرا . الطريقة و الكود في المرفقات لكم مني أطيب التحيات محول المعادلات السريع.rar

مساء الخير ل أساتذتى و أهلى وأصدقائى فى بيتنا أوفيسنا البيت الكبير أوفيسنا بعد غياب دام لفترة مش عارف قد اية فاتنى الكثير جدا جدا فى المنتدى حبيت أرجع بحاجه غريبة جت فى دماغى لقيتها فى موبايل واحد صاحبى برنامج أسمه samsung health حبيت اعمل حاجه صغيرة جدا شبيه بالفكرة بس أكسيل يارب تعجبكم . Track.rar

السلام عليكم اسمحو لي بتعليق بمثابة التنويه في المشاركة الثانية تم اغفال شرط المقارنة من الاستاذ ابو خليل واعتقد نسيانا مما جعل الاخ ابو نادر يتركه في مثاله المرفق وهذا سيسبب خطا على كل حال ورايت بان اخ ابو نادر غير النص في الجدول الى انجليزي بدلا من العربي اي كتبت electronic بدلا من الالكترونيات وهذا ليس مطلب للحل ابدا بل ستظهر بيناتك في تقاريرك بالانجليش تكرما اخ ابو نادر تجربة التالي فالموضوع من حسن الحظ ان شرط التاريخ هو تاريخ اليوم من ما يجعل دالة date() كفيلة سواء تارخ هجري او ميلادي If Nz(DLookup("[raf]", "tamam_tarhel", "[raf]='electronic' And [tarekh]=date()"), 0) <> 0 Then بالتوفيق

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

عملت لك المثال بالوحدة النمطية المسؤولة عن التحويل الى هجري ولا تنسى ابو هادي صاحب العمل من دعواتك الآن اذا اردت ان تدخل تاريخ اليوم الحالي اكتب الدالة () UmDate بدلا من Date ايضا يمكنك استخدام جميع دوال التاريخ الانجليزية في التاريخ الهجري فقط اضف قبلها الحرفين Um ولا تنسى القوسين المعقوفين راجع الوحدة النمطية العامة وادرسها جيدا وستعلم الجهد والابداع في هذا العمل حقل التاريخ الميلادي الموجود في الجدول ضروري فقد تحتاجه مستقبلا tamam3.rar

جرب هذا الملف مبدئياً لاستخراج المواد اقل من 50 Book90 salim.rar

قم بتغيير الكود الى هذا Private Sub Worksheet_SelectionChange(ByVal Target As Range) ActiveSheet.Unprotect '================== For Each cel In Target.Cells Application.EnableEvents = False If cel.HasFormula Then cel.Locked = True cel.FormulaHidden = True With ActiveSheet .Protect .EnableSelection = xllockedCells End With GoTo 1: Else ActiveSheet.Unprotect End If Next 1: Application.EnableEvents = True End Sub

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

تفضل تم تعديل الكود ويعمل بكفاءة عندي لا يعمل بسبب التاريخ الهجري واعتقد السبب في النظام عندي جرب ووافني بالنتيجة Dim i As Integer i = DCount("id", "tamam_tarhel", "raf='" & "electronic" & "'" & " And tarekh=#" & Date & "#") If i > 0 Then Me.av.BackColor = 64636 Me.av.ForeColor = 9382400 Else Me.av.BackColor = 2037680 Me.av.ForeColor = 16053492 End If

جرب هذا الملف كل شيء يتم جسابه في الورقة Print بعد تعبئة البيانات الصحيحة حسب الاسماء والارقام(يوجد اسم واحد ورقم واحد يتكرر في كل الصفحة)و التواريخ يمكن عمل دالة Sumifs في الورقة All لمعرفة كل شخص ماذا يستحق تم حماية الخلايا التي تحتوي على معادلات (لعدم العبث بها عن طريق الخطأ) تم ايضاً وضع المعادلات بحيث تحسب عدد الساعات اذا تجاوزت 24 ساعة (دوام ليلي) مثلا( من الساعة 11 مساءً الى الثالثة بعد منتصف الليل) calculation - Mar. 2016 salim.rar

السلام عليكم ورحمة الله المعادلة المقترحة في الخلية F3 (معادلة صفيف)... أرجو أن تفي الغرض المطلوب... Book2.rar

شكرا جزيلا أخي صالح على ردك السريع :) وأشكر جهدك فيما تفضلت.. ما أريده لو سمحت لي .. أنني لنفترض أريد البحث عن الأشخاص الذين هم Architect مثلا ويسكنون في Beirut وبالتالي عليّ أن أضع في البحث في الـ Classification1 و 2 كلمتي architect و beirut، وبالتالي سيعطيني فقط الأشخاص الذين يحملون هذان التصنيفان على سبيل المثال. وأحيانا يكون البحث عبر 3 تصنيفات إلخ .. ما قدمته لي أخي الكريم مشكوراً، لم يقم بفرز الأشخاص بحسب التصنيفات، فهل يمكنك التفضل علي ومساعدتي بحل هذه المشكلة لدي؟ مع الشكر الجزيل لك ولمساعدتك عزيزي أقدرها جدا :)

الف شكر لحضرتك وصلت المعلومة كاملة جزاك الله خير

ممكن ذلك اذا استعملت المرفق و ضغطت على الزر Run انظر هذا الملف Split.rar

تفضل الملف مع معادلاته salim_work.rar

وعليكم السلام استخدام الحروف العربية تسبب لخبطة في ترتيب الجمل داخل الكود مما يصعب فهمه بل يستحيل هذا تعديل للكود بطريقتك if DLookup("[الرف]","التمام_ترحيل","[الرف]='" & [الإلكترونيات] & "'" and "[التاريخ]=#" & date() & "#" )Then وهذا تعديل بعد كتابة الحروف بطريقة صحيحة يفهمها طالب العلم if DLookup("[raf]","tmamTrhel","[raf]='" & [Electronyat] & "'" and "[tareekh]=#" & date() & "#" )Then

و عليكم السلام اخي العزيز محمد النجار اعجبني السؤال اشكرك ... و الشكر موصول لاستاذنا العزيز رمهان و الذي دلني عليه الحل تطلب مني الغاء المفتاح الاساسي لحقل mid الكود التالي يوضع في زر الاسفل Dim rs As dao.Recordset Dim frm As Form Dim downMid, downFood, downUnit, TopMid, TopFood, TopUnit As String Dim downQuantity, downPrice, TopQuantity, TopPrice As Double Dim Bkmark As String Set frm = Me![main].Form Set rs = frm.RecordsetClone If rs.RecordCount = 0 Then Exit Sub End If rs.Bookmark = frm.Bookmark TopMid = rs("mid") TopFood = rs("food") TopUnit = rs("unit") TopQuantity = rs("qty") TopPrice = rs("price") rs.MoveNext If rs.EOF Then Exit Sub Else Bkmark = rs.Bookmark downMid = rs("mid") downFood = rs("Food") downUnit = rs("Unit") downQuantity = rs("qty") downPrice = rs("price") rs.Edit rs("mid") = TopMid rs("food") = TopFood rs("Unit") = TopUnit rs("qty") = TopQuantity rs("price") = TopPrice rs.Update End If rs.Bookmark = frm.Bookmark rs.Edit rs("mid") = downMid rs("food") = downFood rs("Unit") = downUnit rs("qty") = downQuantity rs("price") = downPrice rs.Update frm.Requery frm.Bookmark = Bkmark مع تغيير السطرين 17 و 18 الى rs.MovePrevious If rs.BOF Then لزر الاعلى ملاحظه : Mid هو اسم لداله و من الافضل عدم استخدامه حيث انه يعتبر اسم محجوز تفضل المرفق بعد التعديل و بالتوفيق ترتيب سجلات.rar

جرب هذا الملف لعمل ذلك يجب ادخال هذا المكرو في موديل مستقل في ملفك Function joincels(rg As Range) s = "" If rg.Rows.Count <> 1 Then joincels = "Error": Exit Function For Each cel In rg If cel <> "" Then s = s & cel & " " End If Next joincels = s End Function join_names.rar

انسخ هذه المعادلة الى الخلية O6 و اسحب نزولاً =REPLACE($H6,1,(FIND(")",$H6)),"") انسخ هذه المعادلة الى الخلية P6 و اسحب نزولاً =SUBSTITUTE(REPLACE($H6,1,(FIND(")",$H6)),""),"-","")

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

هلا استاذ كرار .. وينك اخوي ؟ .. فاقدينك ان شاء الله بخير وعافية تفضل هذا الكود من محفوظاتي : Option Compare Database Private Declare Function SetWindowLong Lib "user32" Alias _ "SetWindowLongA" (ByVal hWnd As Long, ByVal nindex As Long, _ ByVal dwnewlong As Long) As Long Private Declare Function GetWindowLong Lib "user32" Alias _ "GetWindowLongA" (ByVal hWnd As Long, ByVal nindex As Long) As Long Const WS_CLOSEBOX = &H80000 Const GWL_STYLE = (-16) Sub RemoveCloseBox() Dim i As Long Dim hWnd As Long hWnd = Application.hWndAccessApp i = GetWindowLong(hWnd, GWL_STYLE) i = i And Not (WS_CLOSEBOX) i = SetWindowLong(hWnd, GWL_STYLE, i) End Sub Private Sub Form_Open(Cancel As Integer) RemoveCloseBox End Sub Private Sub Form_Close() DoCmd.Quit End Sub اخفاء ايقونة اطار.rar

أخي الكريم ابن الملك عوداً حميداً .. لقد اشتقنا إليك ولمشاركاتك الرائعة والقيمة بارك الله فيك على الموضوع الجميل .. في الحقيقة في بداية الأمر لم أفهم الملف ثم قمت بالإطلاع على الأكواد لأعرف ما يحدث فوجدت العجب العجاب .. :) وفي الحقيقة أعجبتني فكرة الملف ونظرت نظرة مدقق ووجدت أن الأمر أيسر من كل ذلك .. لما كل هذه الموديولات والأكواد واستخدام الـ Selection العديد من المرات .. واستخدام عمود مساعد لابجاد التاريخ المطابق للتاريخ الموجود في الخلية H2 (وعامل إخفاء قال يعني فيه حاجة بتخفى علينا في الإكسيل :) ) المهم هديتي لك بمناسبة رجوعك للمنتدى كود واحد وبس .. لكل الأزرار الثلاثة (شاي وقهوة ومية .. بس متنسانيش بإزازة حاجة ساقعة .. صفرا إذا أمكن) المهم الكود بالشكل التالي Sub Tea_Coffee_Water_Proc() 'Author : YasserKhalil 'Release : 18 - Aug. - 2016 '-------------------------- Dim Obj As Object Dim iCol As Long Dim Rng As Range Dim strDate As Date Dim iRow As Long Application.ScreenUpdating = False With Sheets("Sheet1") 'Get Column Number For Form Button Set Obj = .Buttons(Application.Caller) iCol = Obj.TopLeftCell.Column 'Get Row Number For Date strDate = CLng(.Range("H2").Value2) Set Rng = .Columns(3).Find(What:=strDate, LookIn:=xlValues) If Not Rng Is Nothing Then iRow = Rng.Row 'The Mission .Cells(iRow, iCol).Value = .Cells(iRow, iCol).Value + 1 .Cells(.Cells(Rows.Count, iCol).End(xlUp).Row, iCol).Select End With Application.ScreenUpdating = True End Sub فكرة الكود بتعتمد على إني بعرف رقم العمود المطلوب العمل عليه من خلال زر الأمر .. المرسوم في الخلية (شاي - قهوة - مياة) وبعد كدا بجيب رقم الصف بالاعتماد على البحث ولكن بالأكواد .. وموضح دا في التعليقات (التعليقات بالإنجليزي عشان محدش يفهمني غلط) وأخيراً تقدر تضع القيمة المطلوبة وهي زيادة مقدار الخلية بمقدار واحد من خلال سطر واحد .. وفي النهاية يتم تحديد آخر خلية في نفس العمود أرجو أن يكون الكود مفيد ومختصر .. تقبل وافر تقديري واحترامي

جرب هذا الملف ترتيب أبجدى 2003 salim.rar

وعليكم السلام أخي الكريم وائل في الخلية التي فيها التعليق اعمل كليك يمين ثم اختر الأمر Show/Hide Comments ثم اتبع ما في الصور لتقوم بالمطلوب

هذا الكود يسمح لك بتحديد الخلية المحمية فقط دون ان يسمح بأي اجراء عليها(حذف--- تعديل---نسخ ---الخ) و يخفي المعادلة ايضاً و لا يأخذ بالحسبان الا المعادلات ( جربه و اعطني رأيك) Private Sub Worksheet_SelectionChange(ByVal Target As Range) ActiveSheet.Unprotect If Target.HasFormula Then With Target .Locked = True .FormulaHidden = True End With With ActiveSheet .Protect .EnableSelection = xllockedCells End With End If End Sub

انسخ هذا الكود الى حدث الصفحة و اعطني رأيك Private Sub Worksheet_SelectionChange(ByVal Target As Range) '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Application.ScreenUpdating = False If Target.HasFormula = True Then Application.DisplayFormulaBar = False ActiveSheet.Protect Application.ScreenUpdating = True Exit Sub Else Application.DisplayFormulaBar = True ActiveSheet.Unprotect End If Application.ScreenUpdating = True End Sub

الفتوى ستحصل عليها في قسم الاكسل سيتم إعادة الموضوع الى قسم الاكسل بعد تعديل العنوان

أخي الحبيب / أبو البراء أشكرك جزيل الشكر على مجاملتك الرقيقة والتي لا تخلو من مبالغة الأحباب وأرجو الاطلاع على المرفق وفيه بعد تشغيل الكود وبنقرة مزدوجة على أي إسم بالعمود B التي تمثل الأسماء المكررة يذهب بك إلى موقع الخلية الأولى للإسم بالعمود A ثم التالية وهكذا حتى آخر تكرار إذا اخترت من الرسالة YES أما إذا اخترت NO يكتفي بما ذهب إليه . أرجو أن يكون هذا ما طلبت . تحياتي أبو عبدالله قائمة بالمكرر وعدد مرات التكرار وعناوين المكرر - 1.rar

أخي الحبيب / أبو البراء إلى جانب الحلول الجميلة والمختلفة التي قدمها إخواني الأعزء ، هذا حل آخر لعله يضيف جديد للموضوع . تقبل تحياتي أبو عبدالله قائمة بالمكرر وعدد مرات التكرار وعناوين المكرر.rar

السلام عليكم ============ اخى العزيز halwim اذا كنت فهمت قصدك فيكون المطلوب هكذا حماية الاوراق من تعديل اسمها.rar

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

السلام عليكم و رحمة الله و بركاته إضافة لحل الأخ أبو عبدالله أخي إذا كنت تقصد المربع في الصفحة أعلاه و ما يعرف ب Shape قم بتحديد المربع ثم Right Click ثم اختار Format AutoShape و من مربع الحوار الذي سيظهر قم باختيار Properties و قم بإلغاء علامة الصح عن هذا الخير Print Object

أخي العزيز بالمرفق قم بمعاينة الطباعة ولاحظ عدم وجود أي نص بالخلايا ( A1:C1 ) وبعد الانتهاء من المعاينة إذا لم يظهر لك مفتاح إغلاق المعاينةاضغط ESCAPE للخروج من مود المعاينة - الفكرة تتم من خلال كود حدثي BEFORE PRINT على مستوى الملف تم تعيين إسم الورقة به والنطاق المطلوب تطبيق الفكرة عليه وهي جعل لون خط خلايا النطاق ابيض عند المعاينة او الطباعة ثم العودة للون الموجود مع ملاحظة أن الكود يتعامل مع النطاق المحدد على أن لون الخط الموجود فعلاً لون واحد في الخلايا الثلاثة بغض النظر عن اللون وهذا للعلم فإذا تم جعل الألوان مختلفة في كل خلية لون مختلف عن الآخر فإن الكود لن يعمل بشكل صحيح حتى يتم تعديله . تحياتي أبو عبدالله إخفاء الكتابة عند الطباعة.rar