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

السلام عليكم ورحمة الله وبركاته إخواني الكرام في المنتدى الحبيب سبق أن قدمت في موضوع سابق دالة مشابهة لدالة اليوم ، ولكن دالة اليوم مميزة من ناحية سنقوم بسردها بعد قليل رابط الموضوع المتعلق بشبيهة الدالة فاصل ونواصل (أصلي تعبت ... ) دا شكل الدالة المعرفة Function GetUnique(R As Range) Dim Cl As Range, J As Long With CreateObject("System.Collections.ArrayList") For Each Cl In R.Cells If Cl <> "" Then If Not .contains((Cl.Value)) Then .Add (Cl.Value) Next .Sort For J = 1 To R.Count .Add ("") Next J GetUnique = Application.Transpose(.toarray()) End With End Function ايه رأيكم في شكلها (أنا شايف إنها شكلها لطيف ...مش كدا يا أبو يوسف) تقوم الدالة المعرفة UDF والتي تسمى GetUnique ، باستخراج القيم الغير مكررة في نطاق أي القيم الفريدة في نطاق ، والجديد والمفيد أنه يمكن ترتيب القيم لتحصل في النهاية على قائمة منقحة ومصححة وخالية من التكرار والفراغات .. كل دا بضربة واحدة (ضربة معلم ..صح يا حوسو) إذاً وظيفة الدالة : الحصول على قيم فريدة اي غير مكررة - ترتيب النتائج ترتيب أبجدي - التخلص من الفراغات الموجودة في القائمة الأصلية وبالمثال المرفق سيتضح المقال كيفية عمل الدالة : بفرض أن القيم المراد استخراج القيم الفريدة منها في العمود الأول في النطاق A1:A30 نشوف العمود اللي عايزين نستخرج النتائج فيه وليكن العمود G .. اشمعنا العمود دا بالذات ، عشان العمود ده رقم 7 وأنا من عشاق الرقم 7 ومضاعفاته .. نحدد النطاق من أول الخلية G1 لحد G30 قبل ما نكتب المعادلة حددنا النطاق (برافو عليك يا حوسو) روح بقا لشريط المعادلات (مش ظاهر معاك يبقا أكيد لعبت في إعدادات الإكسيل .. ودي حاجة مش وحشة دي حاجة حلوة ، لأنها دليل إنك عايز تتعلم .. اظهر شريط المعادلات من التبويب View هتلاقي كلمة Formula Bar جنبه مربع علم عليه ..! مش أحسن ما هو اللي يعلم عليك) ضع المعادلة التالية في شريط المعادلات =GetUnique(A1:A30) ومن لوحة المفاتيح اضغط Ctrl + Shift + Enter لأن دي معادلة صفيف .. ومبروك عليك القايمة الجديدة (على أساس إنك متجوز للمرة التانية .. بس القديمة تحلا ولو كانت أحلى ..بلاش نقول وحلة لناخد مخالفة (من خاف سلم)) طيب دلوقتي أنا سامع واحد بيقولي إنت ليه بتجبرني إني أرتب القيم (أنا عايز القيم زي ما هي بدون تكرار وبدون فراغات بس الترتيب ميلزمنيش) .. أرد عليه وأقوله ولا تزعل نفسك يا حبيبي روح لمحرر الأكواد ودور على السطر اللي جاي ده واحذفه أو ضع بجانبة تعليق .. بس خلاص ! مش دي اللي هتزعلنا من بعضنا ) .Sort وأخيراً تقبلوا تحيات أخوكم أبو البراء دمتم على طاعة الله Get Unique UDF Function.rar

لعله لمطلوب find salim.rar

اخي مستر ستيف اتوقع لابد ان يكون اللغة موجودة لديك وهنا لاحظ في الريجيستري يوجد الانجليزي ! هل ممكن نحول للعربي الله اعلم هذا الشرح https://msdn.microsoft.com/en-us/library/hh362866%28v=office.14%29.aspx ولي عودة ان شاء الله تحياتي

اعزائي هذا كود رمهاني .. سريع مجاني ..! DoCmd.SetWarnings False Set rs = CurrentDb.OpenRecordset("vtb"): rs.MoveLast: rs.MoveFirst For i = 1 To rs.RecordCount Step 6 Set rs1 = CurrentDb.OpenRecordset("select * from vtb where id between " & i & " and " & i + 5 & " order by id"): rs1.MoveFirst Do While Not rs1.EOF xsql_val = xsql_val & "'" & rs1(1) & "'," rs1.MoveNext Loop xsql_val = Left(xsql_val, Len(xsql_val) - 1) DoCmd.RunSQL "insert into rtb(b1,b2,b3,b4,b5,b6) values(" & xsql_val & ")" xsql_val = "" Next i DoCmd.SetWarnings True اخي ابو منتظر : يمكنك تنفيذ الكود في اي مكان . مثلا خلف زر امر وعند النقر ! مع ملاحظة : لو نفذته اكثر من مرة سيكرر البيانات فيمكن وضع سطر واحد حذف سجلات الجدول قبل تنفيذ الكود ! تحياتي وبالتوفيق

السلام عليكم .. اولاً: جزاه الله خيراً جميع اعضاء المنتدى و القائمين عليه حيث ان كل خبرتي في الاكسل استفدتها من هذا المنتدى الرائع .. ثانياً: اهديكم هذا البرنامج المتواضع الخاص بالمخازن .. محتويات البرنامج: 1. مخازن 2. مشتريات 3. مبيعات 4. مرجع مشتريات 5. مرجع مبيعات 6. موردين (دائنون) 7. عملاء (مدينون) 8. سندات قبض (موردين , عملاء) 9. سندات صرف (موردين , عملاء) 10. مصروفات 11. خزينة مميزات البرنامج: سهولة الاستخدام حيث يمكن لأي شخص لا يفهم في المحاسبة استخدامه بكل اريحية يعتمد البرنامج بشكل عام على الاكواد سواء للاصناف او للموردين او للعملاء متابعة حركات الخزينة من مشتريات او مبيعات .. إلخ اعتماد المخزن على طريقة المتوسط المرجع وجود سندات قبض و سندات صرف سواء للموردين او العملاء امكانية اضافة المصاريف طريقة الاستخدام: في البداية يجب اضافة موردين و عملاء و اعطاء كود لكل مورد و كل عميل لاضافة فاتورة مشتريات: 1. التوجه للمخازن و اضافة كود الاصناف واسمها 2. التوجه للمشتريات و اضافة كود الاصناف و الاعداد و الاسعار و رقم المورد و الاختيار من القائمة المنسدلة اذا كانت الفاتورة نقدا او اجل في حال نسيان وضع الفاتورة نقدا او اجل سيتم اعتبارها اجل تلقائياً لاضافة فاتورة مبيعات: 1. التوجه للمخازن و اضافة كود الانصاف و اسمها 2. التوجه للمبيعات و اضافة كود الاصناف و الاعداد و الاسعار و رقم العميل و الاختيار من القائمة المنسدلة اذا كانت الفاتورة نقدا او اجل في حال نسيان وضع الفاتورة نقدا او اجل سيتم اعتبارها نقدا تلقائياً الخزينة: يجب وضع رصيد بداية المدة في الخزينة و هناك خانة للمسحوبات الشخصية و ان شاء الله يتم تطويرها في الاصدارات القادمة ملاحظة: 1. جميع ورق البرنامج محمية بدون كلمة سر ما عدا اول صفحة و يرجى عدم حذفها لو سمحتم 2. الاصدار في مرحلة التجربة (نسخة تجريبية) و غالباً هيكون في بعض الاخطاء البسيطة ان وجودت سيتم تعديلها ان شاء الله .. لو اي شخص وجد أي خطأ يرجى التنبيه و شكراً لكم التحميل: في المرفقات باسوورد فك الضغط: www.officena.net elnour.rar

كود اضافة الدوائر الحمرا ويعمل بطريقة فريده يمكنك استخدام تكبير او تصغير العرض بدون التاثير في وضع الدوائر في اماكنها (سيعمل الكود بدون مشاكل) ActiveWindow.Zoom صف الدرجات متغير هنا الصف رقم 12 اذا كانت الخلية في هذا الصف ليست رقم .. لا تتم اضافة دائرة في صفوف عمود الخلية عمود رقم الجلوس العمود متغير هنا رقم 2 اذا كان هذا العمود فاضي او صفر لن تتم اضافة الدوائر تم عمل زر مزدوج لإضافة وحذف الدوائر باسم (الدائرة) Sub اضافة_حذف() On Error Resume Next Dim XX As Shape Set XX = ورقة3.Shapes("الدائرة") With XX.TextFrame.Characters If .Text = "اضافة الدوائر" Then Circles1 .Text = "حذف الدوائر" Else RemoveCircles1 .Text = "اضافة الدوائر" End If End With On Error GoTo 0 End Sub Sub Circles1() Dim C As Range Dim MyRng As Range Dim V As Shape Dim X As Integer Dim G As Integer, R As Integer '================================================ ' عمود رقم الجلوس G = 2 ' صف الدرجات R = 12 ' نطاق الخلايا الذي تريد اضافة الدوائر فيها Set MyRng = Range("N13:BQ47") '================================================= ' اذا كانت النطاقات مختلفة يمكنك الاشارة اليهم بالتالي 'Set MyRng = Range("O13:O47,Q13:Q47,S13:S47") '================================================= X = ActiveWindow.Zoom Application.ScreenUpdating = False ActiveWindow.Zoom = 100 For Each C In MyRng If Cells(C.Row, G) = 0 Then GoTo 1 If IsNumeric(Cells(R, C.Column)) And Not IsEmpty(Cells(R, C.Column)) And (C.Value < Cells(R, C.Column) Or C.Value = "غ" Or C.Value = "غـ") Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 1, C.Top + 1, C.Width - 2, C.Height - 2) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 1.25 End If 1 Next ActiveWindow.Zoom = X Application.ScreenUpdating = True End Sub Sub RemoveCircles1() Dim shp As Shape For Each shp In ActiveSheet.Shapes If shp.AutoShapeType = msoShapeOval Then shp.Delete Next shp End Sub دعوه طيبه لوجه الله لكل من ساهم في هذه الملف ( عبد الله باقشير ) اضافة و حذف دوائر_2.rar

أتمنى من الله ان تكونوا في تمام الصحة والعافية موضوع بسيط وجديد على البعض وفائدته أنه يعمل إنتقال من الفريمات الموجودة في اليوزر فورم بشكل غير تقليدي وسلس في المثال المرفق يوجد يوزر فورم وبه عدد 2 Frame ويتم الإنتقال من فريم للأخر بزر عادي ولكن طريقة الإنتقال هي موضوعنا الأكواد المستخدمة أكواد الـ UserForm يحتوي على 2 Command Button لإنتقال من فريم للأخر Option Explicit Private Sub CommandButton1_Click() While Frame2.Left > 6 Frame2.Left = Frame2.Left - 10 DoEvents Sleep 10 Wend End Sub Private Sub CommandButton2_Click() While Frame2.Left < 266 Frame2.Left = Frame2.Left + 10 DoEvents Sleep 10 Wend End Sub Private Sub UserForm_Initialize() Me.Width = 262 Frame2.Left = 266 Frame2.Top = 6 End Sub كود مستخدم في Module عادي Option Explicit Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) أتمنى يكون الموضوع خفيف وواضح والمرفق به التطبيق ودمتم في حفظ الله Sliding Form.rar

أحبائي المهتمين في منتدى الإكسيل.. أرفق إليكم طريقة تشغيل ملف اليوتيوب عن طريق الفورم الشرح في رابط الفيديو تشغيل اليوتيوب.rar

شهادة اعتز فيها استاذي العزيز

أخي الحبيب سعد .. ابقا اقرا وتابع الشرح كويس بعد كدا عشان أنا راعيت إني مفوتش حاجة ... لو اتكرر الأمر بعد كدا هنغرمك (عشا لكل الموجودين بالمنتدى) تقبل تحياتي

أخي الفاضل سعد هل حددت النطاق بالكامل أولاً ..يجب تحديد نطاق النتائج بالكامل قبل إدراج المعادلة بمعني لو عايز النتائج في النطاق H1:H30 يبقا تحدد النطاق بالكامل وتروح لشريط العنوان وتضع المعادلة ومن لوحة المفاتيح تضغط Ctrl + Shift + Enter أو ارفق ملفك للإطلاع عليه

هاتفضل دائما وأبدا رائع أخى الحبيب الغالى / ياسر خليل جزاك الله كل الخير وأدام عليك الصحة والعافية

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

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

على فرض ان التاريخ في العامود 1 اكتب هذه المعادلة و اسحب نزولاً: =MONTH(A1)

السلام عليكم أخي أنا عملتهالك بطريقة بدائية شوية حطيت قصاد كل أرقام السيارات في العمود G القيمة 0 واستخدمت دالتي Vlookup و IFERROR بحيث ان كل أرقام السيارات في العمود A سيتم البحث عن كل قيمة في هذا العمود هل هي موجودة في العمود G ولا لا لو موجودة يجيب القيمة اللي قصادها وهي 0 اللي اضفناه في الخطوة السابقة لو مش موجودة هيكتب القيمة من العمود B والدالة المستخدمة كالتلي =IFERROR(VLOOKUP(A3,$G$3:$H$8,2,FALSE),B3) والمرفق يوضح أكثر ان شاء الله لحد ما يدخل الإخوة ويقدموا حلول أفضل بإذن الله find.rar

السلام عليكم اولا ، اللي اوله شرط ، آخره نور انا ما عندي الاكسس 64 بت ، وما عندي تجربة في الموضوع ، لكني اتذكر ان اختنا الفاضلة الدكتورة أم عهود (حفظها الله اينما كانت) ، كان لها اجابة لهذا الموضوع ، فانا هنا ساعي بريد ، اكتب لكم بالضبط ما كتبته هي في منتدى الفريق العربي للبرمجة ، والشرط هنا ، اني قد لا استطيع مساعدتكم للنهاية ، لأني لا املك اكسس 64 بت والظاهر هنا ، ان الشئ الوحيد الذي يختلف فيه 64 بت عن 32 بت هو في بعض اوامر الكود والوحدات النمطية التي تنادي user32 مثلا ، اي انها 32 بت. والان من هنا ورايح هي مشاركة اختنا الفاضلة زهرة: في حالة وجود اكثر من وحدة نمطية بها Declare فإننا سوف نضع مثل هذا الكود في كل وحده نمطية على حده لتعمل على النظامين 32 بت و 64 بت وطبعا تختلف التصاريح من وحده نمطية والأخرى عن بعضها البعض #If Win64 Then Private Declare PtrSafe Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #Else Private Declare Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #End If دالة تحجيم النموذج بعد التعديل Option Compare Database #If Win64 Then Private Declare PtrSafe Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #Else Private Declare Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #End If Public Function resizefrom(frm As Form, bestw As Integer, besth As Integer) On Error Resume Next wrate = DisplaySize(0) / bestw hrate = DisplaySize(1) / besth frm.InsideWidth = frm.InsideWidth * wrate frm.InsideHeight = frm.InsideHeight * hrate Dim fc As Control For Each fc In frm.Controls fc.Top = fc.Top * hrate fc.Left = fc.Left * wrate fc.Width = fc.Width * wrate fc.Height = fc.Height * hrate fc.FontSize = fc.FontSize * wrate Next End Function اما الوحدات النمطية التي ليس بها Declare فتبقى كما هي بدون اي تغيير ملاحظة هامة للفهم عند اضافة PtrSafe فإنها تحتاج ايضا الى تعديل بعض المؤشرات Long تتغير الى LongPtr مثال Dim lStructSize As LongPtr دالة ()Len تتغير الى ()LenB حتى يتم قبولها في نظام 64 فقط مثال tsFN.lStructSize = LenB(tsFN) بقية المؤشرات مثل String و Boolean فإنها تبقى كما هي بدون تغيير راجع المصدر https://msdn.microsoft.com/en-us/library/office/gg264421.aspx بالتوفيق

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

الأخ الفاضل إسلام مسلم إليك الملف التالي عله يفي بالغرض Countifs Function.rar

الأخ الكريم مولتو (تصدق جعت لما سمعت اسمك) أهلا ومرحباً بك في المنتدى ونورت .. يرجى تغيير اسم الظهور للغة الزهور اللغة العربية يرجى الإطلاع على هذا الرابط لمعرفة التوجيهات (للضرورة ..إذا كنت ستتعامل مع المنتدى بشكل دائم) http://www.officena.net/ib/index.php?showtopic=60147 يرجى إرفاق ملفك الذي به المشكلة المشكلة بشكل مبدئي سببها الخلايا المدمجة ................................ إذا أزلت الدمج ستحل المشكلة تقبل تحياتي

أخي الحبيب صلاح يتم استخدم الكلمة Call ثم اسم الإجراء الفرعي المراد تنفيذه Call MyMacro حيث أن MyMacro اسم الإجراء الفرعي المراد تنفيذه عند فتح المصنف

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

الاخ ياسر لقد قمت بالتعديل على المعادلة كالتالي Sub ConvertFormulaToVBA() Dim I As Long Application.ScreenUpdating = False For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row Cells(I, 3) = (Cells(I, 2) - Cells(I, 1)) / Cells(I, 1) Next I Application.ScreenUpdating = True End Sub هل هذا التعديل صحيح حسب فهم المعادلة اعلاه

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

السلام عليكم أخي أبو البراء الغالي: الله يسعد جميع أوقاتك صباحها ومساءها...بنور الإيمان

في أسفل كل مشاركة تجد كلمة "تحديد كأفضل إجابة" قم باختيار أفضل إجابة لك وانقر على الكلمة .. ومتنساش اسم الظهور للغة العربية لمعرفة كافة ما يرتبط بالتعامل مع المنتدى راجع الرابط التالي (ويا ريت كل الأخوة الجدد يطلعوا على الرابط ... للضرروة) http://www.officena.net/ib/index.php?showtopic=60147

الأخ الفاضل astika أما آن لك أن تقوم بتغيير اسم الظهور للغة العربية يرجى تحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي تقبل تحياتي

مجهود مشكور اخى إسلام أبو جومانة و بارك الله فيكم و زادكم من علمة

عملية البطء سببها الدوارة الداخلية والسرعة زادت الضعف تقريبا عندما استبدلتها Do While Not Rst.EOF Rst1.Fields(m) = Rst.Fields(0) m = m + 1 Rst.MoveNext Loop حين استبدلتها بهذه For p = 1 To n Rst1.Fields(m) = Rst.Fields(0) m = m + 1 Rst.MoveNext Next p

الأخ الكريم أحمد أهلا بك في المنتدى يرجى تغيير اسم الظهور للغة الزهور اللغة العربية إليك الكود التالي عله يفي بالغرض Sub ConvertFormulaToVBA() 'لتظهر النتائج في العمود الثالث [=A1(A1-B1)] يقوم الكود بتحويل المعادلة '---------------------------------------------------------------------- Dim I As Long Application.ScreenUpdating = False 'حلقة تكرارية من الصف الأول لآخر صف به بيانات في العمود الأول For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row 'الخلية في العمود الثالث تساوي الخلية في العمود الأول مضروبة في الفرق بين الخليتين Cells(I, 3) = Cells(I, 1) * (Cells(I, 1) - Cells(I, 2)) 'الانتقال للخلية التالية Next I Application.ScreenUpdating = True End Sub يرجى فيما بعد وضع المعادلات بين أقواس التنصيص الخاصة بالكود حتى تظهر بشكل منضبط تقبل تحياتي Convert Formula To VBA.rar

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

من الافضل ان ترفق طلبك ليتسنى للإخوة أساتذتنا الكرام الاطلاع ومعرفة سبب التكرار

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

بعد إذن أخى" سليم " وجزاكم الله على كل مجهودكم التى تبذلوة فى المنتدى ولأخى السائل أستخدم هذه الصيغة بفرض أن البيانات فى الخلية " A1 " إستخدم هذه الصيغة وأسحبها لأسفل ستحقق المطلوب بإذن الله =ROUNDDOWN(A1/0.5,0)*0.5 تقبلوا تحياتى تقريب رقم.rar

الأخ الحبيب أبو يوسف بارك الله فيك وجزيت خيراً على كلماتك الطيبة هناك موضوع للأخ ياسين استكمالاً لهذا الموضوع على هذا الرابط ..إن شاء الله يكون فيه فايدة أكبر http://www.officena.net/ib/index.php?showtopic=61626 تقبل تحياتي

وعليكم السلام ورحمة الله وبركاته الاخ الكريم / شريف ابو عبد الرحمن لقد اجتهدت فى حل سؤالك ، أسأل الله أن يكون الحل المطلوب رصيد مستخلص من ميزان مراجعه.rar

عارف إنك ممكن تكسل تقرا المشاركة اللي فاتت فعملت لك فيديو ع السريع تقبل تحياتي

لا تنشرها جزاك الله خير ... ادخل وحمل وستعرف !! جمعة مباركة اخواني الكرام اللهم صلي علي سيدنا ((( محمد ))) وعلي آله وصحبه اجمعين جمعة مباركة.rar

اخى الفاضل ازاى يعني لا يوجد كود، الكود لا يعمل من خلال زر أمر ... لكن بمجرد فتح الملف سيري ان كان تاريخ اليوم اكبر من التاريخ الذي حددته سيحذف بيانات الشيت .. غير ذلك يبقي الوضع كما هو عليه .... شاهد المرفق وعامة هذا هو الكود انشئ موديول جديد والصق به هذا الكود مع تغيير التاريخ للتاريخ الذي تريده Sub ClearSheet() Dim Ddate As Date Ddate = "28/02/2015" If Date > Ddate Then Sheet1.Cells.ClearContents End If End Sub وفي حدث فتح الملف الصق هذا السطر Private Sub Workbook_Open() ClearSheet End Sub تحياتي Code.rar

اخى الفاضل تفضل الملف المرفق لعله يفي بالمطلوب .. غير التاريخ بالكود للتاريخ الذي تريد حذف محتويات الشيت بعده تحياتي ClearAfterDate.rar

السلام عليكم اخي الكريم ابو خليل احببت اشارككم اخر الحلول لقد اشتريت خزينة المال وطريقة التعامل معها سهلة جدا وهي عبارة عن نقوم بتوصيل كيبل الطابعة usb في الخزينة تم من الخزينة نقوم بتوصيل كيبل اخر usb بالجهاز وفي هده الحالة عندما نقوم باعطاء امر طباعة يقوم الامر بفتح الخزانة اولا الف شكر للاهتمامكم

ملحق الدرس الرابع الخاص بالرسائل نستعرض هنا الرساله التى تحتوى على مربع ادخال بيان قد يكون اسم ما وقد يكون كلمه سر للدخول فيما يختص بالجزئية الأولى يكون كود الرساله بهذا الشكل وهذا الكود على سبيل المثال Sub example() Dim result As String result = InputBox("Text?", "Title") If result <> "" Then End If End Sub فتكون الرساله بهذا الشكل كما بالصورة التالية وإذا أفترضنا أننا نريد أن يجعل الاكسل يظهر الاسم او الكلمه التى ستكتب داخل هذا المربع فيكون الكود بهذا الشكل Sub example_1 () Dim result As String ("result = InputBox("Text ?", "Title", "write the name If result <> "" Then MsgBox result End If End Sub الاختلاف بين الكودين فى اضافة هذه الجملة Msgbox result وهى تعنى ظهور رساله تاليه بها الجملة التى تم ادخالها بالمربع فتظهر الرساله كما بالصورتيين التاليتين بعد كتابه الاسم على سبيل المثال تظهر الرساله بالشكل التالى نأتى لجزئية كلمة السر لقد جعلت الكود خاص بالمثال العملى المرفق يختص بالدخول الى الشيت الثانى وقد سجلت الكود بمحرر الأكواد الخاص بحدث الشيت الثانى أى داخل الصفحه نفسها من خلال الفيجوال بيسك وان شاء الرحمن سوف نتطرق لأمر الأكواد بشىء من التفصيل فى الدروس القادمة وما هو الفرق بين الكود داخل موديول أو بحدث الشيت أو بحدث المصنف بالكامل والكود الخاص برساله كلمه السر كالتالى Private Sub Worksheet_Activate() xx: Dim x x = InputBox("Password required" & Chr(13) & "يلزم معرفة كلمة السر للدخول لهذه الصفحه ", "فضلاً أدخل كلمة السر") If IsNull(x) Or x = "" Then GoTo xx If x = "بسم الله" Then MsgBox "كلمة السر تم قبولها تفضل لتنفيذ العمليه" Else MsgBox "Wrong Password" & Chr(13) & " عفواً لم تدخل كلمة السر الصحيحه سيتم العوده بك للصفحة الرئيسيه !!", vbOKOnly Sheets("sheet1").Activate End If End Sub فعند محاولة الدخول للشيت الثانى تظهر لنا الرساله كما بالصورة التالية وعند كتابة كلمه السر وهى بسم الله بين الكلمتين مسافة واحده فقط تظهر لنا رساله بهذا الشكل وبالضغط على زر OK يتم الدخول الى الشيت الثانى فى حال كوننا لم ندخل كلمه السر الصحيحة تظهر لنا رساله توضح ذلك وتنتقل مباشرة الى الشيت الأول والرساله كما بالشكل التالى مرفق ملفين الأول ملحق الدرس الرابع PDF الثانى مثال عملى لما ورد بالدرس وتقبلوا منى وافر الاحترام والتقدير ملحق الدرس4.rar مثال عملى ملحق الدرس 4.rar

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

واصل ابداعاتك اخى الكريم . جمعة مباركة

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

بعد حمد الله وبمساعدة خبراء المنتدى الأستاذ طارق محمود والأستاذ رجب جاويش تم عمل شيت كنترول خاص بالصف الأول الثانوي وهذا العمل جميع عمليات الترحيل والتصفية بطريقة المعادلات لأنني لا اجيد طريقة الاكواد. المدرسة يوجد بها ثلاث فئات من الطلبة طالب منتظم طالب منازل مدرسة (تعدى غيابه 31 يوم وفصل واعيد قيده مرة أخرى) طالب منازل من الخارج وبعد الانتهاء من العمل لاحظت الاتي:- كبر حجم الملف حيث ان حجم الملف يقارب 9 ميجا عدم السرعة في تنفيذ الأوامر في صفحة شيت رصد الدرجات بشكل ملحوظ فارجوا المساعدة من خبراء المنتدى الكرام في التعديل على الملف المرفق لزيادة سرعة تنفيذ الأوامر في شيت رصد الدرجات وتقليل حجم الملف ملحوظة : الحماية الداخلية للملف (0) ولكم منى جزيل الشكر رابط الملف http://www.gulfup.com/?FYDeZC

اخي الحبيب / حمادة عمر تحية خالصة لك من القلب عملك رائع ومتميز وشرحك وسردك للطريقة باسلوب بسيط يسفيد منه الجميع جزاك الله خيرا وسلمت وبارك الله لك بالتوفيق ان شاء الله دائما ولا اجد كلمات اعبر بها ولا شيء اقوله بارك الله فيك تقبل تحياتي

الكود التالي يعيد كافة القيم الإفتراضية لحقول النموذج ، وكأننا ننتقل لسجل جديد ... Private Sub btnClear_Click() Dim ctl As Control On Error Resume Next For Each ctl In Me.Controls ctl.Value = ctl.DefaultValue Next Set ctl = Nothing End Sub والسلام ختام

اخي الكريم عند ظهور هذه الرسالة اختر لا ستظهر لك كما بالصورة اختر صيغة الملف الماشر عليه وسيتم الحفظ ابواحمد

و هذا برنامج جاهز يصنع نظام الصلاحيات تلقائيا للأستاذ المبدع مهند عبادي Users_Maker_2.rar