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

السلام عليكم إخواني الكرام في المنتدى الرائع أقدم لكم كود بسيط يتم وضعه في حدث Worksheet_BeforeDoubleClick يقوم الكود بوضع علامة صح عند النقر المزدوج على أي خلية في النطاق A1:A100 يمكنك تغيير النطاق إلى أي نطاق تريده .. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("A1:A100")) Is Nothing Then Cancel = True Target.Font.Name = "Marlett" If Target = vbNullString Then Target = "a" Else Target = vbNullString End If End If End Sub

بعد إذن الحبيب ياسر يمكنك كتابة المسافة بين الدائرتين مثلا في الخلية A5 ثم في الخلية D5 نكتب هذه المعادلة =((2*22/7*D2/2)-(D3*D4))/D4 لتظهر لنا المسافة بين الدوائر الصغيرة الموجودة على محيط الدائرة الكبيرة الخارجية ويمكنك نسخ المعادلة أفقيا إلى الخلية E5 لتحسب للدائرة الصغيرة الداخلية

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

الأخ الفاضل أبو حسنين إليك الملف التالي عله يفي بالغرض Sub TestRun() Const PI As Double = 3.14159265358979 Const D2R As Double = PI / 180# Const CtrX As Double = 300 Const CtrY As Double = 300 Dim A As Double Dim RadBig As Double Dim RadSml As Double Dim ICol As Long Dim SHP As Shape Dim AvdInp As Variant For Each SHP In ActiveSheet.Shapes If SHP.Type = msoAutoShape Or SHP.Type = msoTextBox Then SHP.Delete Next SHP AvdInp = Range("B2:C4").Value2 For ICol = 1 To UBound(AvdInp, 2) RadBig = CDbl(AvdInp(1, ICol)) DrawCircle CtrX, CtrY, RadBig RadSml = AvdInp(2, ICol) For A = 0 To 359.99 Step 360 / AvdInp(3, ICol) DrawCircle CtrX + RadBig * Sin(A * D2R), CtrY - RadBig * Cos(A * D2R), RadSml Next A Next ICol End Sub Sub DrawCircle(CtrX As Double, CtrY As Double, rad As Double) Dim SHP As Shape Set SHP = ActiveSheet.Shapes.AddShape(msoShapeOval, CtrX - rad, CtrY - rad, 2 * rad, 2 * rad) With SHP.Fill .Visible = msoTrue .ForeColor.RGB = vbWhite .Transparency = 0 .Solid End With End Sub يتم كتابة المعطيات في النطاق D2:E4 ثم تنفيذ الكود لا تنسى أن تحدد أفضل إجابة ليظهر الموضوع مجاب ومنتهي .. كما لا تنسى أن تضغط على كلمة "أعجبني هذا" ولا تضغط عليها إذا لم ينل الملف إعجابك Draw Circles By Code.rar

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

المشاركة رقم 4 (اشكرك يا اخي لقد وفيت بالمطلوب) المشاركة رقم 5 (حاولت استخدام التنسيق الشرطي ولم اتوصل الي حل) شكلي لسه صايم

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

السلام عليكم قبل صلاه العشاء والتراويح حبيب اجى واقول جزاك الله كل الخير وجدت ضالتى فى موضوعك (Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean If Not Intersect(Target, Range("h5:g17")) Is Nothing Then Cancel = True Call mas End If End Sub ()Sub mas() ("ActiveCell = Format(Now, "hh:nn ampm End Sub

لعمل ما تريد يمكنك تغيير الماكرو mas إلى ما يلي Sub mas() If Not Intersect(ActiveCell, Range("g5:h17")) Is Nothing Then ActiveCell = Format(Now, "hh:nn:ss ampm") End If End Sub وفقنا الله وإياكم لكل ما يحب ويرضى

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

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

أخي الكريم أبو حنين إليك حل آخر بدالة معرفة تسهل عليك استخدام المعادلة بدلاً من معادلة الصفيف الطويلة جداً Public Function SumTime(DataRange As Range, CodeRange As Range, SectorRange As Range, StartDate As Date, EndDate As Date) Dim ArrIn, ArrOut, ArrCode, ArrSector, I As Long, J As Long, P As Long ArrIn = DataRange.Value ArrCode = CodeRange.Value ArrSector = SectorRange.Value ReDim ArrOut(1 To Application.Caller.Rows.Count, 1 To 1) For I = (UBound(ArrCode, 1) + 1) To UBound(ArrOut, 1): ArrOut(I, 1) = "": Next I For P = 1 To UBound(ArrCode, 1) If P > UBound(ArrOut, 1) Then Exit For For I = 1 To UBound(ArrIn, 1) If CStr(ArrCode(P, 1)) = CStr(ArrIn(I, 3)) Then If ArrIn(I, 2) >= StartDate And ArrIn(I, 2) <= EndDate Then For J = 1 To UBound(ArrSector, 2) If (ArrIn(I, 7) <> "") And (ArrIn(I, 7) = ArrSector(1, J)) Then ArrOut(P, 1) = ArrOut(P, 1) + ArrIn(I, 10) Exit For End If Next J End If End If Next I If ArrOut(P, 1) = 0 Then ArrOut(P, 1) = "" Next P SumTime = ArrOut End Function قم بإدراج الدالة في موديول ثم لاستخدام الدالة قم بتحديد النطاق H5:H10 اضغط F2 من لوحة المفاتيح ثم قم بإدراج المعادلة بهذا الشكل =SumTime(عام!$G$5:$P$50,$A$5:$A$10,$B$4:$G$4,$A$2,$E$2) ثم اضغط Ctrl + Shift + Enter البارامتر الأول هو نطاق البيانات من ورقة العمل "عام" البارامتر الثاني هو النطاق A5:A10 الذي يحتوي أكواد الإدارات البارامتر الثالث هو النطاق B4:G4 الذي يمثل المهام البارامتر الرابع هو تاريخ البداية البارامتر الخامس هو تاريخ النهاية لا تنسى أن تضغط كلمة "أعجبني هذا" وتحدد أفضل إجابة إذا كانت الإجابة أفضل تقبل تحياتي حركة السائقين.rar

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

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

الفكــــرة 8 / ب التطبيق بالمرفقات VLOOKUP _8.rar

السّلام عليكم و رحمة الله و بركاته أستاذي الغالي ياسر خليل .. تعلّمت منكم أنتم إخواني المصريين من خلال التلفزيون طبعًا عبارة ( الكِبير يبْآى كِبير ) لذلك ستبقى دائمًا يا ياسر يا خليل كبيرنا الذي علّمنا السحر ..لا تقلقْ أستاذنا الغالي أقصد سحر الاكسل و الأكواد بارك الله فيك و جزاك الله خيرًا

السلام عليكم و رمضان كريم كيف يمكن مقارنة نتيجة طالبين بواسطة VBA عسى ان ينال اعجابكم COMPAIRE NOTES.rar

السلام عليكم ورحمة الله وبركاته من المعروف ان اغلب ماكينات الصراف الالى ATM لا تصرف الكسور التى تقل عن 10 جنيها مثلا لو كان المبلغ 2798 تقوم بصرف 2790 جنيها فقط ويتبقى 7 جنيها لاتصرفهم . وبافتراض انه مطلوب منك اعداد كشف الرواتب لتحويلها الى البنك مع تقريب المبالغ الى اقرب عشره تقبلوا تحياتى التقريب الى ادنى 10.rar

هل هذا ما تريد Database1051.rar

أخي الفاضل لا يوجد مرفق.. تأكد من رفع المرفق مضغوط

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

أ. صلاح الصغير جزاك الله خيراً اخى الكريم لمرورك المستمر وكلماتك التى تنقل شعوركم الطيب

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

أخي الحبيب الاستاذ / سعد عابد مرورك شرفني بارك الله فيك وجزاك خيرا بالنسبة لفورم الايصال سوف افصله لك في فورم لحاله وارسله لك وبالنسبة(( progsss bar )) هي احدي حركات اخي الحبيب / شوقي ربيع (جزاه الله خيرا) ويمكنك بالتحكم في الوقت كما تشاء وسوف ارسلك الملف مع فورم الايصال ان شاء الله

السلام عليكم الاخ الكريم / ابوالزوز كان الله في العون وأزال الله عنكم كل سوء اما بالنسبة لمفلك فمرفق ملف للاستاذ القدير العلامة الخبير / عبد الله باقشير به ما تريد تماماً حتي موضوع الاسم المركب من خلال دالة من صنع يديه ( بارك الله لنا فيه ) واليك رابط الموضوع الاصلي للاستاذ القدير باسم ( دالة تجزئة الاسماء من اسم طويل ) http://www.officena....showtopic=33289 واليك المرفق الموجود بالموضوع وجزاك الله خيرا تجزئة الاسماء من اسم طويل.rar

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

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