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

السلام عليكم ورحمة الله وبركاته جزاكم الله خيراً ..وجعلكم نبراساً للعلم ومنارة لإخوانك أخي الحبيب حسام تقبل تحياتي العطرة والسلام عليكم

استاذى الفاضل / هانى بدر جرب المرفق تم عمل المطلوب الاول أما المطلوب الثانى لم أفهم قصدك جيدا يرجى مزيد من التوضيح تقبل تحياتى Rooms.zip

الأخ العزيز كريم بارك الله فيك وجزاك الله كل خير ملف جميل جداً ومتميز .. الأخ الحبيب أحمد الملف الذي أرفقه الأخ كريم عبارة عن موديول تم تصديره ليكون ملف منفصل ، ويتم استيراده بالشكل التالي : روح لمحرر الأكواد ..كليك يمين في نافذة المشروع .. اختار الأمر Import File .. حدد مكان الملف الذي أرفقه الأخ كريم بعد فك ضغطه بالطبع والذي امتداده Bas .. وأخيراً انقر الأمر Open .. ستجد أن الموديول قد أضيف في نافذة المشروع وإليك الكود الموجود بالملف بعد تنسيقه بشكل مناسب (أحب تنسيق الأكواد ليسهل التعامل معها) Private Function ChangeToDigits1(Temp As String) As String If Temp = "0" Then ChangeToDigits1 = "" GoTo Finish End If If Temp = "1" Then ChangeToDigits1 = "واحد" GoTo Finish End If If Temp = "2" Then ChangeToDigits1 = "اثنان" GoTo Finish End If If Temp = "3" Then ChangeToDigits1 = "ثلاثة" GoTo Finish End If If Temp = "4" Then ChangeToDigits1 = "أربعة" GoTo Finish End If If Temp = "5" Then ChangeToDigits1 = "خمسة" GoTo Finish End If If Temp = "6" Then ChangeToDigits1 = "ستة" GoTo Finish End If If Temp = "7" Then ChangeToDigits1 = "سبعة" GoTo Finish End If If Temp = "8" Then ChangeToDigits1 = "ثمانية" GoTo Finish End If If Temp = "9" Then ChangeToDigits1 = "تسعة" GoTo Finish End If Finish: End Function Private Function ChangeToDigits2(Temp As String) As String Dim Digit1 As String Dim Digit2 As String Dim Between As String Digit2 = Left(Temp, 1) Digit1 = Right(Temp, 1) If Digit2 = "1" Then ChangeToDigits2 = "عشر" GoTo Finish End If If Digit2 = "2" Then ChangeToDigits2 = "عشرون" GoTo Finish End If If Digit2 = "3" Then ChangeToDigits2 = "ثلاثون" GoTo Finish End If If Digit2 = "4" Then ChangeToDigits2 = "أربعون" GoTo Finish End If If Digit2 = "5" Then ChangeToDigits2 = "خمسون" GoTo Finish End If If Digit2 = "6" Then ChangeToDigits2 = "ستون" GoTo Finish End If If Digit2 = "7" Then ChangeToDigits2 = "سبعون" GoTo Finish End If If Digit2 = "8" Then ChangeToDigits2 = "ثمانون" GoTo Finish End If If Digit2 = "9" Then ChangeToDigits2 = "تسعون" GoTo Finish End If Finish: If Digit1 = "0" Then Digit1 = "" Between = "" Else If Digit2 = "1" Then Between = " " Digit1 = ChangeToDigits1(Digit1) Else Between = " و " Digit1 = ChangeToDigits1(Digit1) End If End If If Digit2 = "0" Then Between = "" ChangeToDigits2 = Digit1 & Between & ChangeToDigits2 If Temp = "00" Then ChangeToDigits2 = "" If Temp = "11" Then ChangeToDigits2 = "احدى عشر" If Temp = "12" Then ChangeToDigits2 = "اثنا عشر" If Temp = "10" Then ChangeToDigits2 = "عشرة" End Function Private Function ChangeToDigits3(Temp As String) As String Dim Between As String Dim Handred As String Dim First As String Dim Second As String Handred = " مائة" First = ChangeToDigits1(Left(Temp, 1)) Second = ChangeToDigits2(Right(Temp, 2)) If Second <> "" Then Between = " و " Else Between = "" If First = "" Then Between = "" Handred = "" End If If First = "واحد" Then First = "" If First = "اثنان" Then First = "" Handred = "مئتا" End If ChangeToDigits3 = First & Handred & Between & Second If Temp = "000" Then ChangeToDigits3 = "" End Function Private Function ChangeToDigits4(Temp As String) As String Dim Between As String Dim Thousand As String Dim First As String Dim Second As String Thousand = " آلاف" First = ChangeToDigits1(Left(Temp, 1)) Second = ChangeToDigits3(Right(Temp, 3)) If Second <> "" Then Between = " و " Else Between = "" If First = "" Then Between = "" Thousand = "" End If If First = "واحد" Then First = "" Thousand = "الف" End If If First = "اثنان" Then First = "" Thousand = "الفا" End If ChangeToDigits4 = First & Thousand & Between & Second If Temp = "0000" Then ChangeToDigits4 = "" End Function Private Function ChangeToDigits5(Temp As String) As String Dim Between As String Dim Thousand As String Dim First As String Dim Second As String Thousand = " ألف" First = ChangeToDigits2(Left(Temp, 2)) Second = ChangeToDigits3(Right(Temp, 3)) If Second <> "" Then Between = " و " Else Between = "" If First = "" Then Between = "" Thousand = "" End If If First = "واحد" Then First = "" Thousand = "ألف" End If If First = "اثنان" Then First = "" Thousand = "ألفا" End If ChangeToDigits5 = First & Thousand & Between & Second If Temp = "00000" Then ChangeToDigits5 = "" End Function Private Function ChangeToDigits6(Temp As String) As String Dim Between As String Dim Thousand As String Dim First As String Dim Second As String Thousand = " الف" First = ChangeToDigits3(Left(Temp, 3)) Second = ChangeToDigits3(Right(Temp, 3)) If Second <> "" Then Between = " و " Else Between = "" If First = "" Then Between = "" Thousand = "" End If If First = "واحد" Then First = "" Thousand = "ألف" End If If First = "اثنان" Then First = "" Thousand = "ألفا" End If ChangeToDigits6 = First & Thousand & Between & Second If Temp = "000000" Then ChangeToDigits6 = "" End Function Private Function ChangeToDigits7(Temp As String) As String Dim Between As String Dim Million As String Dim First As String Dim Second As String Million = "ملايين" First = ChangeToDigits1(Left(Temp, 1)) Second = ChangeToDigits6(Right(Temp, 6)) If Second <> "" Then Between = " و " Else Between = "" If First = "" Then Between = "" Million = "" End If If First = "واحد" Then First = "" Million = "مليون" End If If First = "اثنان" Then First = "" Million = "مليونا" End If ChangeToDigits7 = First & Million & Between & Second End Function Private Function ChangeToDigits8(Temp As String) As String Dim Between As String Dim Million As String Dim First As String Dim Second As String Million = " مليون " First = ChangeToDigits2(Left(Temp, 2)) Second = ChangeToDigits6(Right(Temp, 6)) If Second <> "" Then Between = " و " Else Between = "" If First = "" Then Between = "" Million = "" End If If First = "واحد" Then First = "" Million = " مليون " End If If First = "اثنان" Then First = "" Million = "مليونا" End If ChangeToDigits8 = First & Million & Between & Second End Function Private Function ChangeToDigits9(Temp As String) As String Dim Between As String Dim Million As String Dim First As String Dim Second As String Million = " مليون " First = ChangeToDigits3(Left(Temp, 3)) Second = ChangeToDigits6(Right(Temp, 6)) If Second <> "" Then Between = " و " Else Between = "" If First = "" Then Between = "" Million = "" End If If First = "واحد" Then First = "" Million = " مليون " End If If First = "اثنان" Then First = "" Million = "مليونا" End If ChangeToDigits9 = First & Million & Between & Second End Function Public Function ChangeThisNumber(Allnumber As String) As String Dim Temp As String Dim Backed As String Dim Backed2 As String Dim Length As Integer Dim bigCur, smallCur As String Dim intNum As String Dim FloatNum As String Dim I As Integer Dim Found As Boolean Allnumber = Trim(Allnumber) If Not IsNumeric(Allnumber) Then ChangeThisNumber = "خطأ في الإدخال" Exit Function End If I = 1 Do While I <> Len(Allnumber) + 1 If Mid(Allnumber, I, 1) <> "." Then intNum = intNum & Mid(Allnumber, I, 1) Else Found = True GoTo Float End If I = I + 1 Loop Float: If Found Then I = I + 1 Do While I <> Len(Allnumber) + 1 FloatNum = FloatNum & Mid(Allnumber, I, 1) I = I + 1 Loop End If Temp = intNum Length = Len(Temp) If Length = 1 Then Backed = ChangeToDigits1(Temp) If Length = 2 Then Backed = ChangeToDigits2(Temp) If Length = 3 Then Backed = ChangeToDigits3(Temp) If Length = 4 Then Backed = ChangeToDigits4(Temp) If Length = 5 Then Backed = ChangeToDigits5(Temp) If Length = 6 Then Backed = ChangeToDigits6(Temp) If Length = 7 Then Backed = ChangeToDigits7(Temp) If Length = 8 Then Backed = ChangeToDigits8(Temp) If Length = 9 Then Backed = ChangeToDigits9(Temp) Temp = FloatNum Length = Len(Temp) If Length = 1 Then Backed2 = ChangeToDigits1(Temp) If Length = 2 Then Backed2 = ChangeToDigits2(Temp) If Length = 3 Then Backed2 = ChangeToDigits3(Temp) If Length = 4 Then Backed2 = ChangeToDigits4(Temp) If Length = 5 Then Backed2 = ChangeToDigits5(Temp) If Length = 6 Then Backed2 = ChangeToDigits6(Temp) If Length = 7 Then Backed2 = ChangeToDigits7(Temp) If Length = 8 Then Backed2 = ChangeToDigits8(Temp) If Length = 9 Then Backed2 = ChangeToDigits9(Temp) smallCur = StrSmallNameCurrency bigCur = StrLargeNameCurrency Dim Filse As String Dim Between As String Dim JD As String Between = " و " If Backed <> "" Then JD = " " & bigCur & " " Else JD = "" Between = "" End If If Backed2 <> "" Then Filse = " " & smallCur & " " Else Filse = "" Between = "" End If ChangeThisNumber = Backed & JD & Between & Backed2 & Filse End Function استخدام الدالة المعرفة ضع رقم في الخلية A1 وفي الخلية B1 ضع المعادلة التالية =ChangeThisNumber(A1) وإليك الملف المرفق مطبق فيه الدالة المعرفة .. تقبل وافر تقديري واحترامي Spell Number UDF Function Karim.rar

الحمد لله الذي بنعمته تتم الصالحات وجزيت خيراً بمثل ما دعوت لي وزيادة أخي العزيز أحمد تقبل تحياتي

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

استاذى الحبيب / هانى بدر حضرتك عملت تعديل للمشاركه السابقه وطلبت وعمل سكرول بار ادخل حضرتك على الفورم فى مرحلة التصميم ومن خصائص الفريم رقم 2 فعل خاصية الاسكرول بار الى خليها رقم 2 رأسى تقبل تحياتى استاذى الفاضل / احمد الفلاحجى جزاكم الله خيرا لمروركم الكريم استاذى الفاضل هانى انت لك معزة خاصه بقلبى فأنا بأكن لك كل احترام وتقدير لشخصكم الكريم اسال الله ان يديم محبتنا فى الله جرب المرفق على الكود الاول تم تفعيل الاسكرول وتفعيل مؤشر الماوس تقبل تحياتى Rooms.zip

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

استاذى الحبيب / هانى بدر جرب المرفق التالى ان شاء الله هو طلبك تم العمل بكود اخر طبقا للملف المرفق فى المشاركة الاولى لحضرتك سوف يتم اظهار الفريمات طبقا لعدد الاسطر وسوف يتم التمييز باللون لكل ليبل حسب المحتوى كما طلبت وسوف يظهر عنوان عند وضع مؤشر الماوس على اى لليبل ويمكن حضرتك تعمل اى كود عند الضغط على اى ليبل فى حل اخر براسى ممكن اعمله ان شاء الله واذا توصلت لشئ سوف ارفق الملف لحضرتك تقبل تحياتى Rooms - 2.zip

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

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

زين شاشة برنامجك بعلم دولتك واجعلة يرفرفر خفاقا" مرفق مثال بسيط flags.rar

أخي الكريم محمود جرب الكود التالي عله يكون المطلوب ... Private Sub CommandButton1_Click() Dim Coll As New Collection, arrData, arrOut, arrStrSheet, strSheet, arrBlank, arrTemp Dim I As Long, J As Long, K As Long, strKey As String arrStrSheet = Array("المشتروات", "المبيعات") ReDim arrBlank(0 To 4) For K = LBound(arrStrSheet) To UBound(arrStrSheet) With Sheets(arrStrSheet(K)) arrData = .Range("C6:E" & Application.Max(.Cells(.Rows.Count, "C").End(xlUp).Row, .Range("C6").Row)).Value On Error Resume Next For I = 1 To UBound(arrData, 1) strKey = Trim$(arrData(I, 1) & Chr$(2) & arrData(I, 2)) arrTemp = arrBlank arrTemp = Coll(strKey) arrTemp(0) = arrData(I, 1) arrTemp(1) = arrData(I, 2) arrTemp(K + 2) = arrTemp(K + 2) + arrData(I, 3) Coll.Remove strKey Coll.Add Key:=strKey, Item:=arrTemp Next I On Error GoTo 0 End With Next K ReDim arrOut(1 To Coll.Count, 1 To 5) I = 0 For Each arrTemp In Coll I = I + 1 For J = 0 To 3 arrOut(I, J + 1) = arrTemp(J) Next J arrOut(I, 5) = arrOut(I, 3) - arrOut(I, 4) Next arrTemp With Sheets("جرد البضاعة").Range("B5") .CurrentRegion.Offset(1, 1).ClearContents If Coll.Count Then With .Offset(1, 1).Resize(UBound(arrOut, 1), UBound(arrOut, 2)) .Value = arrOut .Sort Key1:=.Columns(1), Order1:=xlAscending, Key2:=.Columns(2), Order2:=xlAscending, Header:=xlNo End With End If End With End Sub وإليك الملف المرفق فيه تطبيق الكود تقبل تحياتي Transfer Purchases & Sales Using Arrays.rar

أخى الفاضل / خالد الرشيدى عندك حق يظهر إن الزهايمر اشتغل تانى هذا السطر لم يعد له أهمية فى الكود وفعلا نسيت حذفه بعد الانتهاء من الشكل النهائى للكود ربنا يستر على الذاكره جزاك الله كل خير ودا الشكل النهائى للكود بعد حذف السطر Sub ragab() Dim x As Integer Dim T As Variant Dim S_name As Range '============================================================= For Each T In Array("عام", "خاص", "مغلق", "مفتوح") On Error Resume Next With Sheets(T) Set S_name = .Columns(2).Find(What:=[d5], LookAt:=xlWhole) x = Application.WorksheetFunction.Match(T, [c8:c11], 0) + 7 .Cells(S_name.Row, 3) = Cells(x, 4) End With Next End Sub

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

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

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

حبيبى يا ابوالبراء الاختلاف فى المحشى لا يفسد للحله قضيه ههههههههههههه جزاك الله خيرا يا ابوالبراء وفقك الله لما فيه الخير والفلاح

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

وعليكم السلام أختي هكذا عمل الكود : اذا كان حقل عدد الاصناف نص ، فالمعادلة هي كما ذكرتي: =DCount("[رقم الفاتورة]";"الفاتورة";"[نوع الفاتورة] = 'شراء' And [عدد الأصناف]='" & [عدد الأصناف] & "'") بينما اذا كان حقل عدد الاصناف رقم ، فالمعادلة ستصبح =DCount("[رقم الفاتورة]";"الفاتورة";"[نوع الفاتورة] = 'شراء' And [عدد الأصناف]=" & [عدد الأصناف]) جعفر

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

وعليكم السلام هناك 3 طرق للتعرف على الحقل الذي قيمته Null (لا قيمة ، او قيمة غير معروفة) ، سنعمل على هذا جدول ، ولاحظ السجلات الفاضية: . في الطريقة الاولى (IsNull) قلنا اذا الحقل Null ، فاعطنا النتيجة 0 ، في الطريقة الثانية (Len) قلنا اذا عدد حروف الحقل تساوي صفر ، فاعطنا النتيجة 1 ، . والنتيجة: . لكن الامر الاكثر إتباعا هو Nz ، ومعناه Null to Zero ، والامر هو NZ([Field_Name], Value to Replace)Q ، واليك 4 امثلة عليه: 1. الطريقة الخطأ في استعمال الامر ، حيث لم نخبر الامر النتيجة التي نريدها في حال اكتشف ان الحقل فاضي ، 2. اذا كان الحقل Null ، فحول نتيجة الحقل الى 0 (وهذه الطريقة الاكثر اتباعا) ، 3. وممكن ان ، اذا كان الحقل Null ، فحول نتيجة الحقل الى 1 (او اي قيمة ثابته) ، 4. والقليل يعرف ، اذا كان الحقل Null ، فتستطيع ان تعطي اي قيمة/معادلة شئت للحقل (لاحظ انا ضرب قيمة الحقل Field1 في 100 وفي 200 ، حسب قيمة Field1) ، وحتى يمكننا ان نستدعي دالة Function : . والنتيجة: . جعفر 292.Nulls.mdb.zip

في الخلية Q2 ضع المعادلة التالية (معادلة صفيف) =IFERROR(INDEX($C$2:$C$13,SMALL(IF(FREQUENCY(MATCH($C$2:$C$13,$C$2:$C$13,0),MATCH($C$2:$C$13,$C$2:$C$13,0))>0,ROW($C$2:$C$13)-1),ROW(A1))),"") تقبل تحياتي

قم باستبدال الفاصلة العادية بفاصلة منقوطة والشرط ضعه بين أقواس تنصيص أخرى غير الموجودة .Range("g6").Formula = "=SUMIF(E6,"">= 0"")"

وعليكم السلام انا عملت لك طريقتين لعمل سجل جديد ، وتفتح النموذجين من ازرار النموذج الرئيسي: . . 1. الماكرو 1 يفتح النموذج frm_Table1 مباشرة على سجل جديد ، وهذه الطريقة هي الافضل ، 2. عند فتح النموذج frm_Table2 ، وعلى حدث "عند الفتح" ، يقوم ماكرو 2 بعمل سجل جديد (وهذا اللي انت قمت به) جعفر 291.English_wordings.mdb.zip

أخي الكريم محمود م ن يرجى تغيير الـ م ن في لقبك بلقبك الحقيقي ليعبر عن شخصكم الكريم جرب التعديل البسيط جداً في الكود الرائع لأخونا الغالي رجب Sub Ragab() Dim X As Integer Dim T As Variant Dim S_Name As Range If MsgBox("هل تريد تنفيذ الأمر؟", vbYesNo) = vbYes Then For Each T In Array("عام", "خاص", "مغلق", "مفتوح") On Error Resume Next With Sheets(T) Set S_Name = .Columns(2).Find(What:=[D5], LookAt:=xlWhole) X = Application.WorksheetFunction.Match(T, [C8:C11], 0) + 7 .Cells(S_Name.Row, 3) = Cells(X, 4) End With Next T Else MsgBox "لم يتم تنفيذ الأمر .. تم إلغاء العملية", 64 End If End Sub تقبل تحياتي

جزاك الله خيرا اخى حسام

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

جزاك الله كل خير حبيبى ابوالبراء نفذتها على q ثم عدت ل p وعدلتها وعرفت الاخطاء وظبطت تمام تعرف ان حاولت استخدمها قبل كده ومظبتش ولكن لما آن اوانها ظبطت والحمد لله بفضل الله ثم بفضلكم جزاك الله خيرا يا ابوالبراء ياغالى عدم اظهار المكرر في القائمة 1المنسدله - AboElbraa.rar

السلام عليكم ورحمة الله وبركاته اخي الكريم ابوالبراء كلنا نعلم مدى حرصك على مساعدة الاخرين ومهما تكلمنا فلن نوفيك ولو جزء مما تستحقه تقبل شكري وتقديري اخي الكريم الأستاذ الصقر ما اروعك حين تصيب الهدف بابسط الطرق نعم هو المطلوب الاول اما عن المطلوب الثاتي فببساطه كل ليبل به عدد من الاحرف او الارقام وكمثال لدينا ليبل عنوانه 101" 1 وآخر عنوانه 102" وهنا نلاحظ ان العنوان الثاني عدد مكوناته 4 وعليه يكون المطلوبان يكون كل ليبل عدد مكوناته 4 احرف او ارقام يتم تلوينه بلون مختلف ويظل كل ماهو اكثر من 4 مكونات بلونه الأصلي ولي طلب آخر واعتذر على الاطاله كيف يمكن التعامل مع كل ليبل سواء بالضغط عليه Click او بالمرور عليه Mouse move وليكن في كلا الامرين المستخدمين في المثال السابق يظهر عنوان جانبي بأول ثلاث مكونات لليبل فيكون في مثالنا من العنوان الأول هو .... رقم الغرفه 101 وفي عنواننا الثاني هو ..... رقم الغرفه 102 وأخيرا ارجو عمل Scroll للفريم حيث انه لو زادت عدد الصفوف فلن تظهر بعد الصفوف تقبل تحياتي وشكري الذي مهما افضت فيهم فلن اوفيك القليل من حقك

وذات التاريخ الاحدث لا ينطبق عليها الشرط

الموظف لا تنطبق عليه الشروط فالمعيار الموجود هو Between -5 And 6 بينما القيمة عند الموظف المذكور 10-

بارك الله فيك أخي وحبيبي الغالي رجب جاويش على أكوادك الرائعة ومرحباً بعودتك كمشرف في المنتدى تقبل تحياتي

أرفق مثالا للتعديل عليه

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

انت كده خليت الفرح على المعازيم هههههههههههه واحنا ناكل احنا هههههههههههههههههههههههه

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

السلام عليكم استاذى / رجب جاويس جزاك الله خيراً .. كود رائع .. وارجو من حضرتك ايضاح ما فائدة هذا الجزء من الكود .. Set Rng = .Range("B6:B" & Cells(Rows.Count, "B").End(xlUp).Row) فلم يستخدم فى سطر الترحيل .Cells(S_name.Row, 3) = Cells(x, 4) تقبل فائق احترامى

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

السلام عليكم تفضل أخى محمود Sub ragab() Dim x As Integer Dim T As Variant Dim Rng As Range Dim S_name As Range '============================================================= For Each T In Array("عام", "خاص", "مغلق", "مفتوح") On Error Resume Next With Sheets(T) Set Rng = .Range("B6:B" & Cells(Rows.Count, "B").End(xlUp).Row) Set S_name = .Columns(2).Find(What:=[d5], LookAt:=xlWhole) x = Application.WorksheetFunction.Match(T, [c8:c11], 0) + 7 .Cells(S_name.Row, 3) = Cells(x, 4) End With Next End Sub بيانات1.rar

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

أخي الحبيب أحمد إليك هدية مني ملف مرفق يمكنك ترجمة أسماء الدوال من الإنجليزية للفرنسية أو العكس ويوجد لغات أخرى .. تقبل تحياتي Translation Of Functions Officena YasserKhalil.rar

هذا لانك وضعت العلامة العشرية للنص كنقطة و نفس الشيء للارقام ليعمل الكود كما تريد يرجى فصل الاحرف بعلامة غير النقطة و سوف يتم تعديل الكود بعد ذلك يمكتك استبدال لكود ليصبح هكذا Sub extract_numbers() Dim mycol As New Collection Dim mycol1 As New Collection Dim mytext, mytext1 As String lr = Cells(Rows.Count, 1).End(3).Row For i = 2 To lr x = Application.WorksheetFunction.Trim(Range("a" & i).Value) On Error Resume Next For t = 1 To Len(x) y = Mid(x, t, 1) If IsNumeric(y) Or Asc(y) = 46 Then mycol.Add y mytext = mytext & y Else mycol1.Add y mytext1 = mytext1 & y End If Next If Asc(Right((mytext), 1)) = 46 Then Cells(i, 2) = Left(mytext, Len(mytext) - 1) Else Cells(i, 2) = mytext End If Cells(i, 3) = Left(mytext1, Len(mytext1) - 1) & Chr(46) & Right(mytext1, 1) mytext = "" mytext1 = "" Next End Sub

اخى الكريم شرح الاكواد كود الاضافة 'اضافه سجل جيد للجدول If MsgBox("هل تريد اضافه السجل" & vbCrLf & "", vbYesNo, " اضافة") = vbYes Then Dim Rs As DAO.Recordset 'اسم الجدول Set Rs = CurrentDb.OpenRecordset("الموظفون") 'اضافه البيانات من مربعات النص للحقول في الجدول Rs.AddNew Rs!رقم_السجل = رقم_السجل Rs!الاسم = الاسم Rs!إجمالي_رصيد_الاجاذات_الاعتيادية_المرحلة = إجمالي_رصيد_الاجاذات_الاعتيادية_المرحلة Rs!عدد_الايام_المستحقة_لهذا_العام = عدد_الايام_المستحقة_لهذا_العام Rs!ألأيام_المطلوبة_لهذا_العام = ألأيام_المطلوبة_لهذا_العام Rs!الرصيد_المتبقي_لهاذا_العام = الرصيد_المتبقي_لهاذا_العام Rs!إجمالي_رصيد_الاجاذات = إجمالي_رصيد_الاجاذات Rs!عدد_أيام_العارضة_لهذا_العام = عدد_أيام_العارضة_لهذا_العام Rs!عدد_الايام_المطلوب = عدد_الايام_المطلوب Rs!باقي_أيام_العارضة = باقي_أيام_العارضة Rs.Update End If Set Rs = Nothing كود البحث 'جلب سجل من الجدول Dim Rs As DAO.Recordset Dim Rs_search As String 'الرقم يجب وضعه If IsNull(رقم_السجل) = True Then MsgBox "ادخل رقم السجل " Exit Sub End If 'اسم الجدول Set Rs = CurrentDb.OpenRecordset("الموظفون", dbOpenDynaset) 'البحث بالرقم المدخل في مربع النص Rs_search = "[id] =" & ID Rs.FindFirst (Rs_search) If Rs.NoMatch Then MsgBox "لا يوجد سجل" Cancel = True Else Rs.Edit 'مربعات النص تساوي القيم من الجدول رقم_السجل = Rs!رقم_السجل الاسم = Rs!الاسم إجمالي_رصيد_الاجاذات_الاعتيادية_المرحلة = Rs!إجمالي_رصيد_الاجاذات_الاعتيادية_المرحلة عدد_الايام_المستحقة_لهذا_العام = Rs!عدد_الايام_المستحقة_لهذا_العام ألأيام_المطلوبة_لهذا_العام = Rs!ألأيام_المطلوبة_لهذا_العام الرصيد_المتبقي_لهاذا_العام = Rs!الرصيد_المتبقي_لهاذا_العام إجمالي_رصيد_الاجاذات = Rs!إجمالي_رصيد_الاجاذات عدد_أيام_العارضة_لهذا_العام = Rs!عدد_أيام_العارضة_لهذا_العام عدد_الايام_المطلوب = Rs!عدد_الايام_المطلوب باقي_أيام_العارضة = Rs!باقي_أيام_العارضة End If Rs.Close Set Rs = Nothing كود التعديل 'تعديل سجل موجود في الجدول If MsgBox("هل تريد تعديل السجل" & vbCrLf & "", vbYesNo, " تعديل") = vbYes Then Dim Rs As DAO.Recordset 'اسم الجدول Set Rs = CurrentDb.OpenRecordset("الموظفون") 'البحث عن رقم السجل المعدل Rs.MoveFirst Do Until Rs.EOF 'اذا وجد السجل If Rs!ID = ID Then 'تحريره Rs.Edit Rs!رقم_السجل = رقم_السجل Rs!الاسم = الاسم Rs!إجمالي_رصيد_الاجاذات_الاعتيادية_المرحلة = إجمالي_رصيد_الاجاذات_الاعتيادية_المرحلة Rs!عدد_الايام_المستحقة_لهذا_العام = عدد_الايام_المستحقة_لهذا_العام Rs!ألأيام_المطلوبة_لهذا_العام = ألأيام_المطلوبة_لهذا_العام Rs!الرصيد_المتبقي_لهاذا_العام = الرصيد_المتبقي_لهاذا_العام Rs!إجمالي_رصيد_الاجاذات = إجمالي_رصيد_الاجاذات Rs!عدد_أيام_العارضة_لهذا_العام = عدد_أيام_العارضة_لهذا_العام Rs!عدد_الايام_المطلوب = عدد_الايام_المطلوب Rs!باقي_أيام_العارضة = باقي_أيام_العارضة Rs.Update End If Rs.MoveNext Loop End If Set Rs = Nothing شكل المرفق النهائى المرفق اتمنى ان ينال اعجابكم ADD-EDIT-SEARCH-ByDAO.rar

أخي الكريم أحمد لو جعلناها سلسلة ..وجب أن تكون الأرقام بالترتيب 1 - 2 - 3 لتظهر السلسلة بالترتيب ، وعلى حسب ما فهمت أنه يمكنك كتابة أي رقم لمعرفة الترتيب الخاص به فمثلاً لو بدأنا برقم 10 سيكون الترتيب العاشر والرقم الذي يليه 5 إذاً الترتيب الخامس جزيت خيراً على مساهماتك القيمة والتي تثري الموضوعات بشكل كبير تقبل تحياتي

أخي الكريم طائع يمكنك استخدام دالة معرفة بهذا الشكل البسيط ..لقد قمت بإضافة من 1 إلى 30 (لعله يكون هناك طرق أفضل لتنفيذ المطلوب) Function SpellNumber(MyNumber) Select Case Val(MyNumber) Case 1: MyNumber = "الأول" Case 2: MyNumber = "الثاني" Case 3: MyNumber = "الثالث" Case 4: MyNumber = "الرابع" Case 5: MyNumber = "الخامس" Case 6: MyNumber = "السادس" Case 7: MyNumber = "السابع" Case 8: MyNumber = "الثامن" Case 9: MyNumber = "التاسع" Case 10: MyNumber = "العاشر" Case 11: MyNumber = "الحادي عشر" Case 12: MyNumber = "الثاني عشر" Case 13: MyNumber = "الثالث عشر" Case 14: MyNumber = "الرابع عشر" Case 15: MyNumber = "الخامس عشر" Case 16: MyNumber = "السادس عشر" Case 17: MyNumber = "السابع عشر" Case 18: MyNumber = "الثامن عشر" Case 19: MyNumber = "التاسع عشر" Case 20: MyNumber = "العشرون" Case 21: MyNumber = "الحادي والعشرون" Case 22: MyNumber = "الثاني والعشرون" Case 23: MyNumber = "الثالث والعشرون" Case 24: MyNumber = "الرابع والعشرون" Case 25: MyNumber = "الخامس والعشرون" Case 26: MyNumber = "السادس والعشرون" Case 27: MyNumber = "السابع والعشرون" Case 28: MyNumber = "الثامن والعشرون" Case 29: MyNumber = "التاسع والعشرون" Case 30: MyNumber = "الثلاثون" Case Else: MyNumber = "" End Select SpellNumber = MyNumber End Function يمكنك استخدام الدالة المعرفة بهذا الشكل =SpellNumber(A1) أرجو أن يفي بالغرض تقبل تحياتي

جرب التعديل التالي (الاسم المستخدم في الكود هو الاسم البرمجي ورقة1) أما الاسم الظاهر في التبويب هو ورقة2 حاول تضبط المسميات بشكل صحيح Sub Test() Dim LR As Integer With ورقة1 LR = .Cells(27, 1).End(xlUp).Row + 1 .Range("A" & LR & ":F" & LR).Value = .Range("A3:F3").Value End With End Sub تقبل تحياتي

وحزيت خيراً بمثل ما دعوت لي أخي الفاضل محمد علي والحمد لله أن تم المطلوب على خير تقبل تحياتي

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

جزاكم الله خيراً

Bak2.rar