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

السلام عليكم. بارك الله فيك يا أخي الفكرة حلوة. أضيف أيضا للحصول على نموذج يتغير لونه كل مرة تقوم بفتحه. أكتب الكود التالي في حدث عند الفتح للنموذج Dim t As Integer Dim r As Date r = Now [t] = Second([r]) Me.تفصيل.BackColor = [t] * 15 و سوف تحصل على نموذج يتغير لونه بإستمرار ملاحظة: أنا فقط قمت بنقل هذا الكود من أحد المنتديات. بالتوفيق

وعليكم السلام أخي الحبيب محي الدين يبدو أنك غير متابع للأخبار فقد امتدت الامتحانات إلى يوم 4 / 7 ..يعني لحد الوقفة ربنا يوقف حالهم وبعد العيد مفيش راحة .. امتحانات الدور الثاني للشهادة الإعدادية وبعدها امتحانات النقل .. وبعدها هيتم نقلنا للمستشفى بسبب الإرهاق وراااااااااااااح الصيف هدر كل عام وأنت بخير

فكره اخ صالح واعتقد يمكن توظيفها لحاجات اخرى ويمكن اختصارها Me.Detail.BackColor = Second(Now()) * 15

السّلام عليكم و رحمة الله و بركاته حاول أخي الكريم مع هذا الملف ربما يفيدك إن شاء الله إحتراماتي للميلادي و الهجري.rar

بسم الله الرحمن الرحيم الحمد لله الواحد القهار، العزيز الغفار، مكور الليل على النهار ، تذكرة لأولي القلوب والأبصار وتبصرة لذوي الألباب والاعتبار ، الذي أيقظ من خلقه من اصطفاه فزهدهم في هذه الدار، وشغلهم بمراقبته وإدامة الأفكار ، وملازمة الاتعاظ والادكار، ووفقهم للدؤوب في طاعته والتأهب لدار القرار، والحذر مما يسخطه ويوجب دار البوار، والمحافظة على ذلك مع تغاير الأحوال والأطوار. أحمده أبلغ حمد وأزكاه، وأشمله وأنماه. أما بعد: رأيت أن أقدم عملا خالصا لوجه الله الكريم لعل الله يتغمدنا برحمته ولذا رأيت أنا الفقير إلى الله المحمدي عبد السميع عبد الغني أن أجمع الأكواد بطريقة منظمة تسهل للجميع الحصول عليها عند استخدام محرك البحث ، ولهذا ساقدم سلسلة من الأكواد كل كود بعنوان واضح يسهل الوصول له في موضوع مستقل وسأشرح كيفية استخدام الكود ماتيسر لي إن شاء الله وعلى الله قصد السبيل ****************************************** هذا كود ترحيل أعمدة معينة في هذا الكود سيتم ترحيل الأعمدة الموجودة في الصفحة المصدر ( الشيت ) ويمكن تغييرها الى أي أعمدة تبغاها ("a1:c1,z1,ai1,ar1,ba1,bl1,bm1,cd1,di1,dj1"). طريقة الاستفادة من الكود افتح ملف اكسيل اضغط على الرز ALT وانت ضاغط على الزر اضغط على F11 الموجود أعلا لوحة المفاتيح ستظهر شاشة الماكرو اضغط على موديول 1 سيتم فتح الموديول الصق فيه الكود الموجود تحت هذا السطر [/center] ''' هذا الكود للعالم العلامة / عبد الله باقشير Sub KH_START1() Dim R As Integer, M As Integer, N As Integer Sheets("كشف ناجح").Range("B7:Es1000").ClearContents Sheets("كشف الدور الثاني").Range("B7:Es1000").ClearContents ''' عدد الصفوف العليا في الصفحات المنقول اليها البيانات M = 6: N = 6: S = 6 Application.ScreenUpdating = False ''' بداية ونهاية صفوف الورقة المصدر For R = 11 To 700 ''' رقم عمود المعيار وكلمة المعيار If Cells(R, 113) = "ناجح" Then M = M + 1 ''' أسماء الأعمدة المطلوب نسخها Range("A" & R).Range("a1:c1,z1,ai1,ar1,ba1,bl1,bm1,cd1,di1,dj1").Copy ''' سيتم اللصق في هذا الشيت With Sheets("كشف ناجح") ''' سيتم اللصق بدءا من عمود .Range("B" & M).PasteSpecial xlPasteValues .Range("B" & M).PasteSpecial xlPasteFormats .Range("B" & M) = M - 6 End With Application.CutCopyMode = False ''' للصفحة الأخرى المطلوب الترحيل إليها 'رقم عمود المعيار وكلمة المعيار ElseIf Cells(R, 113) = "دور ثان في" Then ''' لترك صف اعلا كل صف N = N + 2 ''' أسماء الأعمدة المطلوب نسخها Range("A" & R).Range("a1:c1,z1,ai1,ar1,ba1,bl1,bm1,cd1,di1,dj1").Copy ''' سيتم اللصق في هذا الشيت With Sheets("كشف الدور الثاني") .Range("B" & N).PasteSpecial xlPasteValues .Range("B" & N).PasteSpecial xlPasteFormats .Range("B" & N) = (N - 6) / 2 End With Application.CutCopyMode = False End If Next MsgBox "تم ترحيل " & M - 6 & " طالب ناجح" & Chr(10) & Chr(10) & _ "تم ترحيل " & (N - 6) / 2 & " طالب دور ثاني", vbMsgBoxRight, "الحمدلله" Application.ScreenUpdating = True End Sub ودمتم في حفظ الله ترحيل مفيد باختبار اعمدة معينة.rar

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

السلام عليكم و رحمة الله و بركاته رمضان سعيد أما بعد: هذا كتاب برمجي خاص بالاكسل و الـ VBA و هو مفيد جدا و يتكون من 411 صفحة باللغة الانجلزية. التحميل http://ebook-dl.com/download/excel_vba_programming_for_dummies_john_walkenbach

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

السلام عليكم ورحمة الله كان هناك شخص لديه مشروع واحببت ان اساعدة فا طلب ان اساعدة بتغير الوان الخلفية الفكرة جميله واحببت ان اشارككم بالفكرة المرفق تنفيذ للفكرة تغير لون الخلفية.rar

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

اخي الكريمفايز فراج كل عام وانتم بخير جرب الملف التالي لعله يفي بالغرض abo_abary_شيت كنترول الصف الأول الإبتدائي 2015-2016.rar abo_abary_شيت كنترول الصف الأول الإبتدائي 2015-2016.rar

السلام عليكم غير هذا السطر If Me.TextBox3.Value < Me.TextBox2.Value Then بهذا السطر If Val(Me.TextBox3.Value) < Val(Me.TextBox2.Value) Then و هذا السطر If Profil.Offset(, 1) < Me.TextBox2.Value Then بهذا السطر If Val(Profil.Offset(, 1)) < Val(Me.TextBox2.Value) Then

السلام عليكم الحمد لله ان موسوم الامتحانات قد انقضى وعاد الغوالي إلى المنتدى الغالي كل عام وأنتم بخير

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

وعليكم السلام ورحمة الله وبركاته If IsNull(Me.p1) Or Me.p1.Value = 0 Then Else DoCmd.SetWarnings False DoCmd.OpenQuery "UP4" DoCmd.SetWarnings True End If

فعلا بالظبط هذا ما يحدث اخي ابو جني

جميلة الفكرة وشكراً لك اخي صالح

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

ياأستاذ محيى ده إحنا اللى إنتهينا وربنا يكملها بالستر وتنتهى على خير وعودا حميدا للغاليين وافر تقديرى

أخي الكريم مهند محسن جرب التعديل التالي عله يفي بالغرض Private Sub CommandButton1_Click() Dim ws As Worksheet Dim iRow As Long If Me.ComboBox1.Value = "" Or Me.TextBox1.Value = "" Or Me.TextBox2.Value = "" Or Me.TextBox3.Value = "" Then: MsgBox "يرجى ادخال كل البيانات اولا", , "فاضل الباوي": Exit Sub Set ws = Sheets("Sheet2") iRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1 Application.ScreenUpdating = False Application.Calculation = xlManual ws.Cells(iRow, 2).Value = Me.TextBox4.Value ws.Cells(iRow, 4).Value = Me.TextBox1.Value ws.Cells(iRow, 6).Value = Me.ComboBox1.Value ws.Cells(iRow, 8).Value = Me.ComboBox2.Value ws.Cells(iRow, 10).Value = Me.ComboBox3.Value ws.Cells(iRow, 12).Value = Me.TextBox2.Value ws.Cells(iRow, 34).Value = Me.TextBox3.Value ws.Cells(iRow, 1).Value = Me.Label59 If Me.Frame1.Visible = True Then ws.Cells(iRow, 14).Value = Me.Frame1.ComboBox4.Value ws.Cells(iRow, 16).Value = Me.Frame1.ComboBox17.Value ws.Cells(iRow, 18).Value = Me.Frame1.ComboBox18.Value ws.Cells(iRow, 20).Value = Me.Frame1.ComboBox19.Value ws.Cells(iRow, 22).Value = Me.Frame1.ComboBox20.Value ws.Cells(iRow, 24).Value = Me.Frame1.ComboBox21.Value ws.Cells(iRow, 26).Value = Me.Frame1.ComboBox22.Value ws.Cells(iRow, 28).Value = Me.Frame1.ComboBox23.Value ws.Cells(iRow, 30).Value = Me.Frame1.ComboBox24.Value ws.Cells(iRow, 32).Value = Me.Frame1.ComboBox25.Value ElseIf Me.Frame2.Visible = True Then ws.Cells(iRow, 14).Value = Me.Frame2.ComboBox5.Value ws.Cells(iRow, 16).Value = Me.Frame2.ComboBox8.Value ws.Cells(iRow, 18).Value = Me.Frame2.ComboBox9.Value ws.Cells(iRow, 20).Value = Me.Frame2.ComboBox10.Value ws.Cells(iRow, 22).Value = Me.Frame2.ComboBox11.Value ws.Cells(iRow, 24).Value = Me.Frame2.ComboBox12.Value ws.Cells(iRow, 26).Value = Me.Frame2.ComboBox13.Value ws.Cells(iRow, 28).Value = Me.Frame2.ComboBox14.Value ws.Cells(iRow, 30).Value = Me.Frame2.ComboBox15.Value ws.Cells(iRow, 32).Value = Me.Frame2.ComboBox16.Value ElseIf Me.Frame4.Visible = True Then ws.Cells(iRow, 14).Value = Me.Frame4.ComboBox7.Value ws.Cells(iRow, 16).Value = Me.Frame4.ComboBox36.Value ws.Cells(iRow, 18).Value = Me.Frame4.ComboBox37.Value ws.Cells(iRow, 20).Value = Me.Frame4.ComboBox38.Value ws.Cells(iRow, 22).Value = Me.Frame4.ComboBox39.Value ws.Cells(iRow, 24).Value = Me.Frame4.ComboBox40.Value ws.Cells(iRow, 26).Value = Me.Frame4.ComboBox41.Value ws.Cells(iRow, 28).Value = Me.Frame4.ComboBox42.Value ws.Cells(iRow, 30).Value = Me.Frame4.ComboBox43.Value ws.Cells(iRow, 32).Value = Me.Frame4.ComboBox44.Value ElseIf Me.Frame3.Visible = True Then ws.Cells(iRow, 14).Value = Me.Frame3.ComboBox35.Value ws.Cells(iRow, 16).Value = Me.Frame3.ComboBox34.Value ws.Cells(iRow, 18).Value = Me.Frame3.ComboBox33.Value ws.Cells(iRow, 20).Value = Me.Frame3.ComboBox32.Value ws.Cells(iRow, 22).Value = Me.Frame3.ComboBox31.Value ws.Cells(iRow, 24).Value = Me.Frame3.ComboBox30.Value ws.Cells(iRow, 26).Value = Me.Frame3.ComboBox29.Value ws.Cells(iRow, 28).Value = Me.Frame3.ComboBox28.Value ws.Cells(iRow, 30).Value = Me.Frame3.ComboBox27.Value ws.Cells(iRow, 32).Value = Me.Frame3.ComboBox26.Value End If Me.TextBox1.Value = "" Me.ComboBox2.Value = "" Me.ComboBox3.Value = "" Me.TextBox2.Value = "" Me.TextBox3.Value = "" Me.ComboBox1 = "" Me.ComboBox4.Value = "" Me.ComboBox17.Value = "" Me.ComboBox18.Value = "" Me.ComboBox19.Value = "" Me.ComboBox20.Value = "" Me.ComboBox21.Value = "" Me.ComboBox22.Value = "" Me.ComboBox23.Value = "" Me.ComboBox24.Value = "" Me.ComboBox25.Value = "" Me.ComboBox5.Value = "" Me.ComboBox8.Value = "" Me.ComboBox9.Value = "" Me.ComboBox10.Value = "" Me.ComboBox11.Value = "" Me.ComboBox12.Value = "" Me.ComboBox13.Value = "" Me.ComboBox14.Value = "" Me.ComboBox15.Value = "" Me.ComboBox16.Value = "" Me.ComboBox7.Value = "" Me.ComboBox36.Value = "" Me.ComboBox37.Value = "" Me.ComboBox38.Value = "" Me.ComboBox39.Value = "" Me.ComboBox40.Value = "" Me.ComboBox41.Value = "" Me.ComboBox42.Value = "" Me.ComboBox43.Value = "" Me.ComboBox44.Value = "" Me.ComboBox35.Value = "" Me.ComboBox34.Value = "" Me.ComboBox33.Value = "" Me.ComboBox32.Value = "" Me.ComboBox31.Value = "" Me.ComboBox30.Value = "" Me.ComboBox29.Value = "" Me.ComboBox28.Value = "" Me.ComboBox27.Value = "" Me.ComboBox26.Value = "" Application.ScreenUpdating = True Application.Calculation = xlAutomatic MsgBox "تم الترحيل بنجاح" Lr = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row Me.TextBox4 = Application.WorksheetFunction.Max(Sheets("Sheet2").Range("B9:B" & Lr)) + 1 End Sub تقبل تحياتي

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

السلام عليكم اخي حسين ... انا لاحظت ان النموذج بعد اي تعديل بسيط عليه و حفظه تكون النتيجة :

السلام عليكم. تفضل أخي. Database51.rar

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

يمكن الاستغناء عن المعادلات والعمل بالأكواد .. فهذا سيكون أخف للملف بشكل كبير ولكن يجب أن توضح المعطيات بشكل جيد لكي يستطيع الأخوة الأعضاء تقديم المساعدة المطلوبة قم بالبحث في المنتدى عن "الملفات المغلقة" ربما تجد أحد الموضوعات التي تمت لموضوعك بصلة ، ويمكن الاستفادة منها ويرجى وضع عناوين مناسبة للموضوعات إليك الملف المرفق التالي عله يفيدك في فهم الفكرة Import Data From Closed WB Using VLOOKUP YasserKhalil.rar

أجسنت أخي الكريم .. اجابة مثالية .. انا ممتن لك..... ممكن اعرف اين كان الخطا كي استطيع تطبيق المثال هل هو فقط في Txt ؟

تفضل اخي الكريم waz-dropdown.rar

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

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

أخى الحبيب الغالى // أبو حنين السلام عليكم ورحمته الله وبركاته صراحة بيعجنى فيك نظافة دماغك ههههههههههه ***** هههههههههههه لذلك أتسمح لى أبتاه أن تُعطينى رأسك لكى أُقبّلهُا عاشت إيديك وعاشت دماغك وسلمت من كل شر تقبل وافر تقديرى وإحترامى ويارب يارب ان تكون بالعام القادم على عرفات الله إنه ولى ذلك والقادرعليه

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

اخي ياسر ليس الموضوع هكذا المطلوب تحويل كل الصفوف الى عامود واحد بينما دالة Transpose تعكس الأعمدة والصفوف يمكن ان يكون هذا الملف يفي بالغرض All_On_One_Column.rar

السلام عليكم ورحمة الله وبركاته إخواني الكرام جمعة مباركة عليكم أقدم لكم كود خفيف دمه ظريف .. الكود يقوم بعمل طريق مختصر للمصنف الحالي إلى سطح المكتب أو ما نسميه Shortcut، وكله بالكود Sub CreateShortCut() Dim oWSH As Object Dim oShortcut As Object Dim sPathDeskTop As String Set oWSH = CreateObject("WScript.Shell") sPathDeskTop = oWSH.SpecialFolders("Desktop") Set oShortcut = oWSH.CreateShortCut(sPathDeskTop & "\" & ActiveWorkbook.Name & ".lnk") With oShortcut .TargetPath = ActiveWorkbook.FullName .Save End With Set oWSH = Nothing End Sub هو دا الكود ..بس خلاص إليكم الملف المرفق قم بفك الملف المضغوط وضع الملف المفكوك في أي مسار على الحاسب الخاص بك ..وديه في الأدغال !! ونفذ الكود لتجد اختصار لمصنفك على سطح المكتب دمتم على طاعة الله ..ولا تنسونا من صالح دعائكم Create Shortcut On Desktop.rar

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

في اي صفحة جديدة املأ الصف من A1 الى اي حلية تريد (Z1 مثلاً ) بأي بيانات و قم بتنفيذ هذا الكود اذا كنت تريدها معادلات سأعمل على ذلك Sub list_to_one_col() laste_col = Cells(1, Columns.Count).End(xlToLeft).Column Do Cells(m + 3, 1) = Cells(1, k + 1) m = m + 1: k = k + 1 Loop Until k = laste_col End Sub

السلام عليكم بعد إذنك أخي رمهان يمكنكي تحقيق مبتغاكي بإتباع الخطوات التالية: 1- جعل مصدر السجلات في مربع نص السعر الإجمالي هو قيمة الحقل السعر الإجمالي 2- إنشاء حدث عند بعد التحديث لمربع النص السعر (منشئ التعليمات البرمجية) و أكتبي فيه التالي: Me.السعر_الإجمالي = Me.السعر * Me.الكمية_المطلوبة أيضا يمكن وضع الكود حتى في مربع النص الكمية المطلوبة بإذن الله سوف يتحقق لك الأمر حتى في أكسس 2007 و الملف المرفق يوضح أكثر قومي بتجريب البرنامج و أطلعينا على النتائج حقل حسابي.rar

السلام عليكم و رحمة الله و بركاته تقبل الله منا و منكم الصيام و القيام. اللهم بلغنا ليلة القدر و اجعل صيامنا صيامنا مقبولا و ذنبنا ذنبا مغفورا. نحن و جميع المسلمين في أقطار العالم يا رب العالمين. أقدم لكم أخوتي الكرام برنامج صغير لكن فكرته جيدة يستفيد منه الأطفال الصغار و الكبار أرجوا أن ينال إعجابكم. المساحات.rar

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

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

السّلام عليكم و رحمة الله و بركاته بارك الله فيك و جزاك الله خيرًا ..أستاذنا القدير "ياسر خليل" على هذا الامتحان المهني خلّصت الواجب ..و سأبعثه .. لا تخفْ .. لأنّه طلع 0 على عشرة .. اللّمسة الأخيرة تنقصني فائق إحتراماتي yasser.rar