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

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

بواسطة المعادلات لا يمكن ادراج صفوف او اعمدة يمكن ذلك فقط بواسطة الكود او يدوياً انظر لى الملف المرفق و اضغط غلى الزر الصف الفارغ salim.rar

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

جرب هذا الشيء قائمة مطاطه.rar

كنت أريد أن أقوم بإخفاء شاشة الاكسيس ، فقمت بالبحث فى المنتديات الاجنبية و وجدت هذة الطريقة و جربتها و كانت سليمة 100 % و نبدأ بالخطوات : 1 - نسخ هذا الكود و لصقة فى module و نسمية باى اسم فهذا لا يهم Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long Dim dwReturn As Long Const SW_HIDE = 0 Const SW_SHOWNORMAL = 1 Const SW_SHOWMINIMIZED = 2 Const SW_SHOWMAXIMIZED = 3 Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _ ByVal nCmdShow As Long) As Long Public Function fAccessWindow(Optional Procedure As String, Optional SwitchStatus As Boolean, Optional StatusCheck As Boolean) As Boolean If Procedure = "Hide" Then dwReturn = ShowWindow(Application.hWndAccessApp, SW_HIDE) End If If Procedure = "Show" Then dwReturn = ShowWindow(Application.hWndAccessApp, SW_SHOWMAXIMIZED) End If If Procedure = "Minimize" Then dwReturn = ShowWindow(Application.hWndAccessApp, SW_SHOWMINIMIZED) End If If SwitchStatus = True Then If IsWindowVisible(hWndAccessApp) = 1 Then dwReturn = ShowWindow(Application.hWndAccessApp, SW_HIDE) Else dwReturn = ShowWindow(Application.hWndAccessApp, SW_SHOWMAXIMIZED) End If End If If StatusCheck = True Then If IsWindowVisible(hWndAccessApp) = 0 Then fAccessWindow = False End If If IsWindowVisible(hWndAccessApp) = 1 Then fAccessWindow = True End If End If End Function ---------------------- 2- قم بعمل ماكرو أسمة mcrHide ضع بة اكشن run code و فى خانة Function ضع الكود التالى fAccessWindow ("Minimize", False, False) ------------------------------ 3 - قم بعمل ماكرو أخر أسمة mcrRestore ضع بة نفس الاكشن السابق run code و فى خانة Function ضع الكود التالى fAccessWindow ("Show", False, False) ------------------------------- 4 - الأن الخطوة الاكثر مللاً إذا كانت لديك العديد من النماذج قم بتغيير خصائص كل النماذج : popup قم بتحويلها إلى yes بدلاً من no ------------------------------- 5- فى النموذج الرئيسى الذى تريدة ان يبدأ بالفتح ضع الكود التالى : Private Sub Form_Open(Cancel As Integer) DoCmd.RunMacro "mcrHide" End Sub ----------------------------- 6 - فى كل التقارير ضع الكود التالى عند الحدث OnOpen DoCmd.RunMacro "mcrRestore" و عند الحدث OnClose DoCmd.RunMacro "mcrHide" ------------------------------- و بهذا تكون قد إنتهت الخطوات ربما تظهر انها خطوات طويلة ، لكنها طريقة فعالة جداً و تعطى منظر إحترافى جميل للبرنامج و اعتذر للإطالة و تحياتى للجميع New_Microsoft_Access_Application.rar

إخواني الأعزاء هذه فكرة سريعة وبعض النقاط الهامة عن برنامج الحسابات الذي كم ذكرت سابقاً يعتمد فكرة مراكز التكلفة ويبدأ من إنشاء دليل الحسابات وتعريف مراكز التكلفة والبيان المكرر في القيود ثم ترحيل القيود واستدعائها وتعديلها بعد الترحيل إذا لزم الأمر وبه إمكانية إصدار كشف حساب وميزان مراجعة ، وهذه بعض التلميحات الهامة للتعامل مع البرنامج : 1- لمسح قيود اليومية بالكامل ( وهي ممسوحة بالفعل بهذا الملف ) وإدخال مسلسل أول قيد وتاريخه من ورقة DATA استخدم أيقونة مسح البيانات والعملية محمية بكلمة سر هي 123 . 2- للانتقال من ورقة لأخرى استخدم الأسهم الزرقاء الموجودة بكل الأوراق واختر من القائمة الورقة التي تريد تفعيلها . 3- إقرأ بتركيز التعليقات / ال COMMENTS الموجودة بعناوين جدول إدخال معلومات القيد بورقة القيود ( JOURNAL VOUCHER ) ففيها تفصيل كل عمليات البحث وتسهيل عملية إدخال البيانات عند إعداد القيد . 4- من أيقونة إضافة حساب – م.تكلفة – بيان بورقة ( JOURNAL VOUCHER ) استخدم مفاتيح الاختيار / OPTIONAL BUTTONS لتحديد نوع الإضافة وعند تفعيلك مفتاح اختيار إضافة حساب ستظهر لك رسالة توضح لك أنه سيتم نقلك لفورم يسهل عليك تحديد الحساب الرئيسي للحساب المطلوب إضافته والرقم المقترح لهذا الحساب ويوجد توضيحات بالفورم ستساعدك على ذلك وعند إضافتك حساب جديد وبعد إكمال كل بياناته ستظهر لك رسالة بخصوص تحديث قائمة الحسابات الرئيسية وافق على التحديث في حالة واحدة فقط إذا كان الحساب الذي ستضيفه هو نفسه حساب رئيسي جديد غير موجود ضمن الحسابات الرئيسية الحالية . 5- تعديل القيد المرحل محمية بكلمة سر 123 من داخل الكود . 6- عند بحثك عن حساب في إعداد القيد وإذا اخترت بالخطأ حساب رئيسي فسيتم تنبيهك لذلك وإذا اخترت حساب من حسابات الميزانية فسيتم نقل المؤشر مباشرة لعمود المدين أم إذا اخترت حساب من حسابات النتيجة فسيتم نقلك لعمود رقم مركز التكلفة . 7- لايمكنك طباعة القيد قبل ترحيله ولا يمكنك ترحيل قيد غير متوازن ولايمكنك إعادة ترحيل قيد مرحل وكل هذا له رسائل تنبيه . 8- عند استدعائك لقيد مرحل من مفتاح استدعاء قيد أدخل رقم القيد بصندوق الإدخال الذي سيظهر لك ، ولا يمكنك تعديل القيد أو ترحيله وإنما فقط الهدف من الاستدعاء هو الاطلاع أو الطياعة من أيقونة طباعة قيد مرحل والتي تتولى إخفاء الصفوف الفارغة بنموذج القيد . 9- يمكنك تعديل قيد مرحل من مفتاح تعديل قيد وبعد استدعاء القيد من خلال تسجيلك لرقمه بصندوق الادخال الذي سيظهر لك بمجرد إدخال كلمة الحماية الصحيحة وضغط ENTER لا تنسى بعد التعديل إعادة ترحيل القيد وستظهر لك رسالة بهذا المعنى لدى استدعاء القيد للتعديل . 10- بكشف الحساب نقرة مزدوجة بالخلية C4 أسفل إسم الحساب ليظهر لك فورم البحث عن الحساب المراد الكشف عنه والبحث مثل كل أنوع البحث في الملف يتم بأب جزء من أي معلومة عن الحساب إسمه أو رقمه ولاختيار الحساب من فورم البحث نقرة مزدوجة على صف معلومات الحساب بقائمة نتيجة البحث بالفورم . 11- أيقونة تحديث كشف الحساب تحتاجها لتحديث كشف موجود قمت بتعديل قيود ضمن حركته أو عمل قيود تؤثر عليه بعد إظهاره بدل استدعائه من جديد . 12- أيقونة "قيد جديد لشهر جديد" في ورقة إعداد القيد تحتاجها إذا كنت تريد تمييز مسلسل القيود لكل شهر مثل أن يبدأ مسلسل القيد برقم الشهر ثم رقم القيد . هذا ما أسعفني به الوقت والذاكرة وطبعاً الموضوع مفتوح للحوار والاقتراحات والتحسينات . تقبلوا تحياتي أبو عبدالله ACCOUNT SOFTWARE W-COST CENTERS - V1.1.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

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله مع التحديث الجديد .. للأسف لم أجد التوجيهات التي تم وضعها من قبل ، وهذه القواعد والأسس هامة جداً ليدرك الأعضاء كيفية التعامل مع المنتدى طبعاً الموضوع سيكون متجدد .. سيتم وضع القواعد مرة أخرى فالرجاء الرجاء أن تساعدوني في اتمام الأمر .. كل عضو يذكرني بتوجيه من هذه التوجيهات ليتم إرساء القواعد ، إذ أن نجاح أي مؤسسة يعتمد في المقام الأول على قواعد ومنهج ثابت للسير على دربه التوجيهات والقواعد التي يجب مراعاتها التوجيه الأول : قبل طرح موضوع جديد يتعلق بطلب محدد يرجى استخدام خاصية البحث أولاً ، فإذا لم يجد طارح الموضوع بغيته ، فعليه أن يقوم بطرح موضوع جديد ، وفي هذه الحالة على طارح الموضوع أن يعلم أن حسن السؤال شطر الإجابة ، فاللباقة واللياقة والكياسة من الصفات التي يجب أن يتحلى بها طالب العلم. التوجيه الثاني : عند طرح موضوع جديد ، يتم وضع عنوان مناسب للطلب بحيث يفهم الطلب قبل الإطلاع عليه ، وعلى طارح الموضوع أن يبتعد عن العناوين الغير مجدية مثل : ( طلب مساعدة - الرجاء المساعدة - ساعدوني من فضلكم - عاجل وهام - الحقوني - نداء للعباقرة - نداء للعمالقة - إلى آخر تلك العناوين ...) ، وأمر آخر ألا يكون العنوان على شكل سؤال أو طلب .. نبتعد عن كلمة "طلب" مثال تطبيقي : نفترض أنني أريد معادلة تجمع القيم في عمودين العنوان المناسب للطلب يكون بهذا الشكل : معادلة جمع القيم في عمودين والنتائج في عمود آخر التوجيه الثالث : أن يتم توضيح المطلوب بالموضوع بشكل يزال معه أي لبس ، وفي نفس الوقت يراعى الإجمال في الطلب ، فأقصر الخطوط هو الخط المستقيم ، بمعنى "لا إطالة مملة ولا اختصار مخل" ، أي لا يكون طرح الموضوع مختصر للغاية بل يجب أن يستوفي جميع العناصر المطلوبة ، ومن ضمنها أن يحدد طارح الموضوع هل الحل المطلوب بالمعادلات أم بالأكواد أم بكلاهما لتكون الأمور واضحة بالنسبة لمن يريد تقديم المساعدة ، وأن يقوم صاحب الموضوع بإرفاق ملف به بيانات وهمية لتوضيح طلبه وللوصول إلى حل سريع ودقيق ، وإذا صعب على طارح الموضوع شرح المطلوب يمكنه إرفاق بعض النتائج المتوقعة كي يسهل الوصول لحل. التوجيه الرابع : نلاحظ أن شكل المنتدى لا يعجب معظم الأعضاء ، فلما لا نغير بأيدينا الشكل العام للمشاركات ، فيفضل على سبيل المثال استخدام حجم خط كبير 22 على سبيل المثال وجعل الخط عريض Bold مما يجعل المشاركة واضحة ومقروءة بشكل جيد ، كما يمكن استخدام الألوان أي قم بتنسيق المشاركة بشكل جذاب يجعل القاريء لا ينفر منها. التوجيه الخامس : بعد الانتهاء من الموضوع والوصول لحل يرضي صاحب الموضوع ، يرجى أن يتم تحديد أفضل إجابة من خلال النقر على علامة الصح الموجودة بجانب كل مشاركة ، وأن يسجل صاحب الموضوع إعجابه من خلال النقر على "سجل اعجاب بهذا" كنوع من رد الجميل لمن قدم المساعدة ، ويمكن أيضاً أن يقوم بتقييم المشاركة تقييم إيجابي كنوع من التقدير ، وأن تشكر من قدم المساعدة فمن لم يشكر الناس لا يشكر الله. فيما يخص لو كان هناك أكثر من إجابة للموضوع ، يمكن لصاحب الموضوع عمل مشاركة جديدة يجمع فيها كل الحلول ويختار هذه المشاركة كأفضل إجابة التوجيه السادس : لا تكن لحوحاً ، يكفي أن أعضاء المنتدى يقدمون وقتهم و خبرتهم مقابل لا شيء وعندهم أعمال أخرى (مشاغلهم الخاصة) يقومون بها ، و إذا تأخر الرد ، فمن الممكن أن يكون أحد الأعضاء يقوم بمحاولة الإجابة ، وهذا يستغرق بعض الوقت خاصةً إذا كان الموضوع صعباً. التوجيه السابع : حمل الملف المرفق دون زركشات (ألوان و تنسيقات مختلفة) مما يزيد من حجم الملف و أحياناً تكون الألوان مقززة بشكل ينفر منها المساعد (خاصةً إذا كانت ألوان الخلايا غير متناسقة مع لون الخط) التوجيه الثامن : تأكد أن الملف المرفوع غير مصاب بفيروس و غير محمي بكلمة سر ، وإلا لن تجد المساعدة من قبل الأعضاء. التوجيه التاسع : متابعة صاحب الموضوع لموضوعه والتفاعل معه ، فلا يعقل أن يطرح أحدهم موضوع ولا يتابعه إلا بعد مرور وقت طويل ، فهذا يعد من اللامبالاة الغير مرغوب فيها ، والتي تنفر الجميع من العضو. التوجيه العاشر : عدم التسجيل في المنتدى بأكثر من حساب ، وأن يكون اسم الظهور باللغة العربية ومعبر عن الاسم الحقيقي أي (تعريب اسم العضو) ، فلا يجوز أن يكون اسم الظهور اسم واحد وفقط بل أن يكون ثنائي على الأقل أو أن يكون اسم ولقب ، ولذا يرجى عدم استخدام الأسماء المستعارة أو الأسماء باللغة الأجنبية ، فاللغة العربية هي هويتنا ولابد من الحافظ عليها. ** يتم تغيير اسم الظهور أو اسم المستخدم من خلال إعدادات الحساب ثم التبويب اسم المستخدم ، قم بتغيير الاسم ثم انقر كلمة حفظ التوجيه الحادي عشر : عدم طرح أكثر من موضوع لنفس الطلب من نفس العضو ، فهذا يعد مخالفة صريحة ، وليعلم العضو الذي يقوم بذلك أن تكرار الموضوع لن يجدي نفعاً في حالة عدم توضيحه للمطلوب. وفي حالة أن قام العضو بذلك عن طريق الخطأ يقوم العضو بالتنويه في الموضوع وطلب حذف الموضوع نظراً لتكراره. التوجيه الثاني عشر : على من يقدم المساعدة أن يكون مثالاً يحتذى به في العطاء والصبر والحلم وكرم الأخلاق وحسن الإجابة ، يجتذب بتلك الصفات عقول الآخرين وأفئدتهم التوجيه الثالث عشر : عند طرح موضوع يفضل أن يكون هناك طلب واحد فقط إذ أن الموضوع الذي تكثر فيه الطلبات ينفر الأعضاء الذين يريدون تقديم يد المساعدة ، وعلى رأي المثل (من يطارد عصفورين يفقدهما) فما بالك لو طاردت أكثر من طلبين أقصد أكثر من عصفورين ، يمكنك أن تتعامل بذكاء بأن تطرح الموضوع بطلب واحد حتى إذا تم على خير قم على الفور بطرح موضع جديد بطلب جديد وهكذا إلى أن يتم الأمر التوجيه الرابع عشر : يرجلا عدم إرسال رسائل خاصة للأعضاء لطلب المساعدة بشكل شخصي ، لأن هذا الأمر يضايق الكثير من الأعضاء ، وتأكد أن العضو إذا كان لديه معلومة أو يستطيع أن يفيد بشيء ووقته يسمح بذلك فلن يتأخر عنك ، يكفي أن تكتب كلمة "للرفع" في موضوعك ، ليشاهده أكبر عدد من الأعضاء. ** كيفية رفع الصور في المشاركات : ******************************* دمتم على طاعة الله

أشكرك اعذرنى على عدم استيعاب طلب الاخير الحمد لله أنك توصلت الى مبتغاك تحياتى

='كنترول شيت'!$C$11:INDEX('كنترول شيت'!$C$11:$C$500;COUNTA('كنترول شيت'!$C$11:$C$500)) جزاكم الله خيرا وبارك فيكم استاذ سليم =OFFSET('كنترول شيت'!$B$11;;;COUNTA('كنترول شيت'!$B$11:$B$1000)) جزاك الله خيرا استاذ ياسر

Sub KH_START() Dim b As Integer, M As Integer Sheets("كشف ناجح").Range("c7:m1000").ClearContents Sheets("كشف الدور الثاني").Range("c7:m1000").ClearContents M = 7: b = 7 Application.ScreenUpdating = False For R = 1 To 1000 If InStr(1, Sheets("الشيت").Cells(R, 113).Value, "ناجح") Then Sheets("الشيت").Range("A" & R).Range("b1:c1,z1,ai1,ar1,ba1,bl1,bm1,cd1,di1,dj1").Copy Sheets("كشف ناجح").Range("c" & M).PasteSpecial xlPasteValues Application.CutCopyMode = False M = M + 1 End If If InStr(1, Sheets("الشيت").Cells(R, 113).Value, "دور ثان") Then Sheets("الشيت").Range("A" & R).Range("b1:c1,z1,ai1,ar1,ba1,bl1,bm1,cd1,di1,dj1").Copy Sheets("كشف الدور الثاني").Range("c" & b).PasteSpecial xlPasteValues Application.CutCopyMode = False b = b + 1 End If Next MsgBox ("الحمد لله تـــم ترحيل الناجحين و الراسبين إلى أوراق عمل جديدة ") Application.ScreenUpdating = True End Sub كود استدعاء رائع بتحسينات الاستاذ المحترم اسامه البراوي حفظه الله ترحيل مفيد باختبار اعمدة معينة 2.

ما هو التعديل المطلوب ؟

' 'هذا الكود للمحترم ياسر العربي Sub RoundedRectangle3_Click() Dim last As Long Dim y As Long '' اول صف سيوضع فيه التذييل y = 40 Do ' ' لمنع اهتزاز الشاشه Application.ScreenUpdating = False last = Sheets("ناجح").Range("a10000").End(xlUp).Row If y - 36 >= last Then GoTo 0 ' ' اسم شيت المصدر الذي سيتم حشر الديباجخ فيه Sheets("كعب الشيت").Rows("2:7").Copy ' ' اسم شيت الديباجه التى نريد وضعها في الشيت المصدر Sheets("ناجح").Rows(y).Insert Shift:=xlDown ' 'لايقاف خاصيه القص والنسخ Application.CutCopyMode = False ' ' y = y + 36 Loop ' ' لاعاده تحديث الشاشه 0 Application.ScreenUpdating = True MsgBox "تم بحمد لله" End Sub ' ' ' ' ' ' ' ' ' ' ' ' ' ' الاستاذ الكريم ياسر العربي وضغت شرح لبعض الجمل لكودك الرائع ليكون مرجعا سهلا للاخوه ارجو ان تكمل الشرح للجمل التي لم استطع شرحها

السلام عليكم بدون تنسيق شرطى و بدون الكود فى الملف الاصلى تفضل الملف بكود جديد وأسهل من الاصلى عسى أن يكون المطلوب دوائر مختار.rar

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة ملف إكسل متواضع لحساب المبيعات والمشتريات والأرباح لمحل الملبوسات تم ارفاق كود الحل من الفاضل/ أبو أكرم و لا تنسونا من صالح الدعاء تحياتى برنامج لمحل ملابس.rar

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

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة كود لترحيل بيانات الى اوراق مختارة من قائمة منسدلة تم ارفاق كود الحل من الافاضل/ عبدالله المجرب _ احمدزمان و لا تنسونا من صالح الدعاء تحياتى ترحيل الى اوراق مختارة.rar ترحيلToYaser (1).rar

الاخت الكريمة تفضلي هذه الفكرة لعلها تفيدك يتم نسخ اسطر لعمل تذييل من كعب الشيت الى شيت ناجح بعد كل 30 طالب مثلا ؟؟؟!! تقبلي تحياتي 1213123.rar

ربنا يبارك فيك استاذ مصطفى محمود والاستاذ سليم والجمع الكريم

زراضافة وحذف دوائر حمراء.rar السلام عليكم لاحظ الملف يعمل جيد لكن فيه زرين اضافة وحذف لعله ينفعكم تحياتي

اخى الكريم al.djaballah بعد التحية جرب المرفق التالى لعلة يفى بالغرض abo_abary_دوائر حمراء.rar

لله درك ورحم الله والديك وجزاك الله عنا خير الجزاء

لتنسيق مربع النص بنمط معين نكتب التالي : TextBox1 = Format(TextBox1, "......") ثم مكان النقاط ".........." نكتب التنسيق الذي نريده مثلا للتاريخ يصبح شكل الكود كالآتي : TextBox1 = Format(TextBox1, "dd-mm-yyyy") و هكذا مع بقية انواع التنسيقات

اخي ناصر السلام عليكم فعلا اخي ناصر تم نقل او تكرار عمود المجموع الكلي الي العمود 95 .... وبهذا تم حل مشكلة ربع الدرجة بالنسبة لعمود المجموع .... لأن الكود عندما يقوم بمقارنة عمود المجموع بعمود ربع الدرجة يجدة فارغ .... بشرط حزف حرف ( م ) من عمود المجموع الأصلي ...... الحل رائع وبسيط ..... جزي الله الأستاذ ابو عبد الباري خيرا ..... وشكرا للجميع ..... ورمضان كريم

جرب هذا الماكرو Sub My_Filter() Range("g8").Resize(50, 3).ClearContents Set myrg = Range("a2", Cells(Cells(Rows.Count, 1).End(3).Row, Cells(2, Columns.Count).End(1).Column)) For i = 1 To Cells(Rows.Count, 1).End(3).Row If Month(myrg(i, 1).Offset(0, 2)) = Month(Range("i5")) And _ myrg(i, 1).Offset(0, 1) = myrg(i, 1).Offset(0, 1) Then _ myrg(i, 1).Resize(1, 3).Copy Cells(p + 8, "g"): p = p + 1 Application.CutCopyMode = False Next End Sub

تم معالجة الامر بواسطة المعادلات انظر الى الصفحتين الاصافيتين فايل تسجيل بيانات salim.rar

تفضل - رمضان مبارك Book1.rar

عذرا لعدم فهمى للمطلوبواليك الملف التالى abo_abary_دوائر حمراء.rar

السلام عليكم كل هذا ممكن : للإنتقال الى أول سطر في الليست بوكس نكتب : ListBox1.ListIndex = 0 للإنتقال الى آخر سطر في الليست بوكس نكتب : ListBox1.ListIndex = ListBox1.ListCount - 1 لحساب عدد الأسطر نكتب : TextBox1 = ListBox1.ListCount لجمع عمود معين و ليكن العمود الرابع مثلا مع العلم ان بداية حساب الاعمدة تبدأ من الصفر و ليس الواحد نكتب ما يلي : Dim i As Long TextBox1 = "" For i = 0 To ListBox1.ListCount - 1 TextBox1.Value = Val(TextBox1) + Val(ListBox1.List(i, 4)) Next

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

الاخ أيمن ابراهيم ( ألن تحتاج الي رأس للشيت ايضا ( ال 9 صفوف في اول الورقة ناجح

جاولي رفع الملف او قسم منه للعمل عليه

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

السلام عليكم أستاذ الظاهر ان موقع النور فيه نوع آخر من ملفات الاكسل ، والذي بشمل علامات لغتي الخالدة فقط ، عليه ، اليك طريقة استيرادهم ، بنفس الطريقة القديمة ، ولكن لجدول خاص به النموذج يطلب منك اختيار نوع ملف الاكسل ، والباقي يقوم الكود به . وهذا كود الاستيراد (طبعا هناك مجموعة من الاستعلامات في البرنامج): Option Compare Database Private Sub Browse_Click() Dim fpath As Variant With Application.FileDialog(3) .Title = "Choose File" .Filters.Clear .Filters.Add "Excel Files", "*.xls ; *.xlsx" '.Filters.Add "Excel Files", "*.csv" .AllowMultiSelect = False .InitialFileName = "" If .Show = -1 Then Me.txtPath = .SelectedItems(1) End If End With Exit Sub End Sub Private Sub ImportData_Click() If Me.frm_Which_Type = 0 Then 'the user didn't choose anything, let him know MsgBox "رجاء اختيار اي نوع من الملفات تريد ان تستورد" & vbCrLf & "Please Select an option" Exit Sub ElseIf Len(Me.txtPath & "") = 0 Then 'don't leave the path empty MsgBox "رجاء اختيار ملف الاكسل" & vbCrLf & "Please select an Excel file" Exit Sub End If '1 'Empty Table Degrees and tbl_Sheets ' CurrentDb.Execute ("Delete * From Degrees") ' CurrentDb.Execute ("Delete * From tbl_Sheets") '2 'import Sheets Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean Dim lngCount As Long Dim objExcel As Object, objWorkbook As Object Dim colWorksheets As Collection Dim strPathFile As String, strTable As String Dim strPassword As String ' Establish an EXCEL application object On Error Resume Next Set objExcel = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set objExcel = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 ' Change this next line to True if the first row in EXCEL worksheet ' has field names blnHasFieldNames = False ' Replace C:\Filename.xls with the actual path and filename strPathFile = Me.txtPath ' "C:\Filename.xls" ' Replace tablename with the real name of the table into which ' the data are to be imported strTable = "tbl_Sheets" '"tablename" ' Replace passwordtext with the real password; ' if there is no password, replace it with vbNullString constant ' (e.g., strPassword = vbNullString) strPassword = vbNullString '"passwordtext" blnReadOnly = True ' open EXCEL file in read-only mode ' Open the EXCEL file and read the worksheet names into a collection Set colWorksheets = New Collection Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , strPassword) For lngCount = 1 To objWorkbook.Worksheets.Count colWorksheets.Add objWorkbook.Worksheets(lngCount).Name Next lngCount ' Close the EXCEL file without saving the file, and clean up the EXCEL objects objWorkbook.Close False Set objWorkbook = Nothing If blnEXCEL = True Then objExcel.Quit Set objExcel = Nothing ' Import the data from each worksheet into the table For lngCount = colWorksheets.Count To 1 Step -1 'If lngCount <> 9 And lngCount <> 8 Then GoTo Next_lngCount '3 'Empty Table Degrees and tbl_Sheets 'j'CurrentDb.Execute ("Delete * From tbl_Sheets") CurrentDb.Execute ("Delete * From " & strTable) '-- '4 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$" '-- '5 If Me.frm_Which_Type = 2 Then 'the user choose Loqati ONLY add_Loqati = "_Loqati" Else add_Loqati = "" End If my_qry_Select = "qry_Select" & add_Loqati my_qry_Delete_Duplicate = "qry_Delete_Duplicate" & add_Loqati my_qry_Append = "qry_Append" & add_Loqati my_qry_Update_Sheet = "qry_Update_Sheet" & add_Loqati 'Delete Duplicate Dim rstQ As DAO.Recordset mySQL = "Select * From " & my_qry_Select Set rstQ = CurrentDb.OpenRecordset(mySQL) [F16] = rstQ![F16] [F8] = rstQ![F8] [F17] = rstQ![F17] [F29] = rstQ![F29] [F24] = rstQ![F24] rstQ.Close: Set rstQ = Nothing DoCmd.SetWarnings False DoCmd.OpenQuery my_qry_Delete_Duplicate DoCmd.SetWarnings True '------------- '6 'append the data DoCmd.SetWarnings False DoCmd.OpenQuery my_qry_Append DoCmd.SetWarnings True '------------- DoEvents Me.iSheet = colWorksheets.Count Me.iSheet2 = lngCount '------------- '7 'append the data DoCmd.SetWarnings False DoCmd.OpenQuery my_qry_Update_Sheet DoCmd.SetWarnings True '------------- '8 'empty tbl_Sheets CurrentDb.Execute ("Delete * From " & strTable) Next_lngCount: Next lngCount ' Delete the collection Set colWorksheets = Nothing MsgBox "Done" ' Uncomment out the next code step if you want to delete the ' EXCEL file after it's been imported ' Kill strPathFile End Sub جعفر 275.3.ImportDegrees.accdb.zip

السلام عليكم . هذا صحيح ، ولكن في نهاية الدالة تستطيع تختار النطاق Range او الورقة/sheet ، فعليه يمكنك ان تعيد الامر اكثر من مرة ، كل مرة لورقة اكسل اخرى (لاحظ اسماء الـSheet): DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet1$" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet2$" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet3$" . ولكن هذا الامر يتطلب منا ان نعرف عدد الاوراق/Sheets ، واسمائها ------------------------------------------------------------------------------------------------------------------------ والآن لشرح ما عملته انا: 1. عملت جدول اسمه tbl_Sheets ، لإدخال جميع المعلومات في جميع الاوراق/Sheets: . وعن طريق الكود (الكود سيكون في نهاية الموضوع) ، يأخذ البيانات ، فيصبح: . ثم يأتي الكود مرة اخرى ، فيملئ حقل ID لكل علامة: . ثم عملت استعلام جدولي CrossTab ، والذي به نستطيع ان نجعل بيانات احد الاعمدة عبارة عن اعمدة متفرقة ، يعني الحقل F1 ، اردنا ان نجعل كل مادة عبارة عن عمود مستقل): . وهذه نتائجه: . والان الى عمل استعلام آخر ، لجمع كل هذه السجلات: . فاصبحت: . الآن وقد اصبحت البيانات جاهزة لإلحاقها بالجدول النهائي Degrees ، نعمل استعلام الحاقي: . والكود الذي يقوم بكل العمل: Private Sub ImportData_Click() 'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet1$" 'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet2$" 'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet3$" Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean Dim lngCount As Long Dim objExcel As Object, objWorkbook As Object Dim colWorksheets As Collection Dim strPathFile As String, strTable As String Dim strPassword As String ' Establish an EXCEL application object On Error Resume Next Set objExcel = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set objExcel = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 ' Change this next line to True if the first row in EXCEL worksheet ' has field names blnHasFieldNames = False ' Replace C:\Filename.xls with the actual path and filename strPathFile = Me.txtPath ' "C:\Filename.xls" ' Replace tablename with the real name of the table into which ' the data are to be imported strTable = "tbl_Sheets" '"tablename" ' Replace passwordtext with the real password; ' if there is no password, replace it with vbNullString constant ' (e.g., strPassword = vbNullString) strPassword = vbNullString '"passwordtext" blnReadOnly = True ' open EXCEL file in read-only mode ' Open the EXCEL file and read the worksheet names into a collection Set colWorksheets = New Collection Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _ strPassword) For lngCount = 1 To objWorkbook.Worksheets.Count colWorksheets.Add objWorkbook.Worksheets(lngCount).Name Next lngCount ' Close the EXCEL file without saving the file, and clean up the EXCEL objects objWorkbook.Close False Set objWorkbook = Nothing If blnEXCEL = True Then objExcel.Quit Set objExcel = Nothing ' Import the data from each worksheet into the table For lngCount = colWorksheets.Count To 1 Step -1 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$" Next lngCount ' Delete the collection Set colWorksheets = Nothing '--------------------------------- ' importing is finished 'now organize the table, by adding the ID to all the group Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Sheets") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC If rst!F1 = "رقم الهوية" Then 'And Len(rst!ID & "") = 0 Then myID = rst!F2 rst.Edit rst!ID = myID rst.Update Else rst.Edit rst!ID = myID rst.Update End If rst.MoveNext Next i rst.Close: Set rst = Nothing 'append the data DoCmd.SetWarnings False DoCmd.OpenQuery "qry_Append_Sheets" DoCmd.SetWarnings True MsgBox "Done" ' Uncomment out the next code step if you want to delete the ' EXCEL file after it's been imported ' Kill strPathFile End Sub . . ولكن ، يجب عليك ان تحذف بيانات الجداول Degree و tbl_Sheets قبل ان تقوم بأي عمل جعفر 275.ImportDegrees.accdb.zip

السلام عليكم أخي الفاضل زي ما توقعت إن المشكلة في الملف ده فقط وهي مش مشكلة هي فقط لأن الصفحات محمية بكلمة سر وتم فك الحماية ويمكن نقل الصفحات والكليك يمين كله يعمل بشكل عادي لاحظت أخي إن كلمات السر للصفحات مختلفة بعض الصفحات تختلف عن الصفحات الأخرى عامة أنا رفعتلك الملف في الرابط التالي الصفحات كلها بدون حماية http://up.top4top.net/downloadf-top4top_6910b2975a1-zip.html

السلام عليكم أساتذتي الكرام بدايةً قام الأستاذ أبو أدم مشكوراً بتزويدي ببرنامج للوثائق وقد قمت بالتعديل عليه ليصبح برنامج للأرشفة وحفظ المراسلات ================================================================= عملي يعتمد في المقام الأول على جهاز الماسح الضوئي ليسحب الوثائق بصيغة pdf والماسح الذي لدي هو من نوع fujitsu fi7160 كما في الصورة ================================================================ هذا النوع من الأجهزة يعطي خيارين لسحب الصور أما بصيغة jpg أو pdf وللتحويل الى نوع pdf توجد هذه الأداة Scan Snap وهذه صورتها عند سحب الصورة تظهر هذه الرسالة ويتم إغلاقها لكي يتم الحفظ في ملف الحفظ المحدد مسبقاً علماً بأنه لا بد من إختيار مجلد الحفظ في هذه الأدة عن طريق الضغط عليها وإختيار كما في الصورة لتظهر هذه الصفحة ============================================================ المطلوب أن يتم التحكم بكل هذه الخطوات السابقة (تتم يدويا) عن طريق الكود في الأكسس إبتداء من المقدرة على تغيير مجلد الحفظ وحتى القيام بسحب الأوراق لانه لسحب الأوراق لابد من الضغط على زر في الماسح علماً أنه يمكن أن يتم عن طريق الضغط Duplux Scanعلى ما هو مبين في الصورة يتم سحب الأوراق ================================================= ملاحظة استطعت القيام بعمل زر لتشغيل الماسح في وضع مسح بصيغة pdf وهذا هو الكود Shell "C:\Program Files\fiScanner\ScanSnap Manager\PfuSsMff" وشكراً

مرفق واضح انك مدرس لغة عربية .... حريص على المذكر والمؤنث ابقى افتح موضوع جديد لو عايز حاجة تانى ترحيل مفيد باختبار اعمدة معينة 2.rar

الأخ الفاضل سامي 741 روح للتبويب Formulas ثم Name Manager ثم حدد رقم_الجلوس المراد التعديل عليه (لاحظت أن هناك عدد 2 نطاق مسمى بنفس الاسم ..احذف واحد وأبقي على الآخر للتعديل عليه ) المهم اضغط Edit ثم في الحقل المسمى Refers To قم بوضع المعادلة التالية ثم أوك ثم Close =OFFSET('كنترول شيت'!$B$11,,,COUNTA('كنترول شيت'!$B$11:$B$1000)) تقبل تحياتي Dynamic Defined Name.rar

الخلايا المراد أن تكون غير محمية يكفي أن تغير تنسيقها ..حدد الخلايا (أعمدة صفوف خلايا متجاورة خلايا غير متجاورة ) ثم كليك يمين ثم من التبويب Protection وأزل علامة الصح بجانب الخيار Locked وكذلك أزل علامة الصح من جانب الخيار Hidden

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

أخى الفاضل جرب هذا الكود show_calc.rar

السلام عليكم تفضل اخي الحاسبة.rar

السلام عليكم و رحمة الله هذه هي النسخة الأخيرة للبرنامج بعد اضافة التحابيش و تحبيك التحابيك مع التحية و التقدير نظام_ORGNL.rar

أخي العزيز / أحمد المرفق به نموذج لإعداد قيد يومية مع مراكز تكلفة بفكرة عمل كل قيد بورقة منفصلة وبشكل تلقائي بالضغط على مفتاح قيد جديد يعطيك قيد BLANK بمسلسل تلقائي كما يمكنك إضافة حسابات جديدة ومراكز تكلفة وبيان يتكرر معك فبدل كتابته كل مرة تبحث عنه ويضع تلقائياً بالنقر عليه بالفورم الخاص بالبحث عن بيان وكل المعلومات الأساسية تعمل بفكرة الإضافة والبحث ومن المهم أن تقرأ التعليقات برأس جدول بيانات القيود ومن المهم جداُ ألا تترك صفوف فارغة عند إكمالك للقيد وطلبك لقيد جديدولديك فكرة النقرة المزدوجة بأي صف في عمود المدين لتضيف أسفله ماتريد من صفوف تحتاجها لإكمال القيدوطبعاً تسجيل رقم وإسم الحساب ومركز التكلفة والبيان كله يتم من خللا البحث بنقرة مزدوجة بالحقل الخاص بكل عنصر على مستوى الجدول بالكامل . لا أحب أن أطيل وأي استفسار لا تتردد في طرحه . تحياتي أبو عبدالله JOURNAL VOUCHER FORM.rar

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته ملف فيه التالي: قائمة فيها خيارين : الخيار الاول : ادخال بيانات فاتورة ادخال فيها 20 صف التاريخ تلقائي رقم تسلسلي تلقائي ويظهر زر ترحيل: 1- تقوم بتعبئة الفاتورة بالصفوف الذي تريدها بالتوالي مع ادخال اسم العميل واسم المشروع 1- تقوم بترحيل الفاتورة الى الورقة الثانية (حفظ) الخيار الثاني: بحث عن بيانات تظهر لك قائمة بالرقم التسلسلي لاختيار رقم الفاتورة الذي تريد معاينتها وعند الاختيار تظهر البيانات المطلوبة مع زر آخر اسمه قيد جديد فائدة الزر قيد جديد: يقوم بتغيير التاريخ الى التاريخ الحالي ويظهر رقم القيد الجديد التسلسلي ويظهر زر الترحيل في حالة اردت استخدام نفس البيانات في فاتورة البحث واستخدامها كفاتورة جديدة غير ما شئت في الفاتورة ثم اضغط زر الترحيل الفائدة من الملف: 1- حفظ الفواتير 2- البحث عن فاتورة معينة عن طريق رقمها 3- استخدام بيانات اي فاتورة قديمة والتعديل عليها وحفظها كفاتورة جديدة بامكانك التعديل على النموذج حيث انه يوجد شرح داخل الكود للمتغيرات المستخدمة في الملف القادم ان شاء الله : خيار جديد اسمه تعديل بيانات لتعديل بيانات فاتورة معينة تفضلوا المرفق ان شاء الله يكون فيه الفائدة ودمتم في حفظ الله وسلامته تحياتي وسلامي اخوكم/ خبور ______________2.rar