حمادة عمر

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

السلام عليكم الاخ الكريم / salim zaid بارك الله فيك تقبل تحياتي جزاك الله خيرا

السلام عليكم الاخ الحبيب والاستاذ الفاضل / خالد القدس بارك الله فيك مرور دائما يشرف اي موضوع جزاك الله خيرا

السلام عليكم الاخ الكريم / netcom199 جزاك الله خيرا

السلام عليكم الاخ الكريم /http://www.officena....showtopic=41520 جزاك الله خيرا

الاستاذ القدير / كيماس موضوع من رواائع المواضيع الموجودة علي النت كاملا جعله الله في ميزان حسناتك موضوع جميل بالفعل ... وعذرا لم اره الا الآن جزاك الله خيرا

الاخ الكريم / محمد اليازجي جاء الرد علي طلبك الاخير بخصوص التفقيط بالعربي في الرابط المرسل من الاخ الحبيب / شوقي ربيع .. جزاه الله خيرا ... وهو يفي بالمطلوب واليك كود آخر ... قم بوضع الكود التالي في مودل Function NoToTxt(TheNo As Double, MyCur As String, MySubCur As String) As String Dim MyArry1(0 To 9) As String Dim MyArry2(0 To 9) As String Dim MyArry3(0 To 9) As String Dim Myno As String Dim GetNo As String Dim RdNo As String Dim My100 As String Dim My10 As String Dim My1 As String Dim My11 As String Dim My12 As String Dim GetTxt As String Dim Mybillion As String Dim MyMillion As String Dim MyThou As String Dim MyHun As String Dim MyFraction As String Dim MyAnd As String Dim i As Integer Dim ReMark As String If TheNo > 999999999999.99 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1 ReMark = "íÊÈÞì áßã " Else ReMark = "ÝÞØ " End If If TheNo = 0 Then NoToTxt = "ÕÝÑ" Exit Function End If MyAnd = " æ" MyArry1(0) = "" MyArry1(1) = "ãÇÆÉ" MyArry1(2) = "ãÇÆÊÇä" MyArry1(3) = "ËáÇËãÇÆÉ" MyArry1(4) = "ÃÑÈÚãÇÆÉ" MyArry1(5) = "ÎãÓãÇÆÉ" MyArry1(6) = "ÓÊãÇÆÉ" MyArry1(7) = "ÓÈÚãÇÆÉ" MyArry1(8) = "ËãÇäãÇÆÉ" MyArry1(9) = "ÊÓÚãÇÆÉ" MyArry2(0) = "" MyArry2(1) = " ÚÔÑ" MyArry2(2) = "ÚÔÑæä" MyArry2(3) = "ËáÇËæä" MyArry2(4) = "ÃÑÈÚæä" MyArry2(5) = "ÎãÓæä" MyArry2(6) = "ÓÊæä" MyArry2(7) = "ÓÈÚæä" MyArry2(8) = "ËãÇäæä" MyArry2(9) = "ÊÓÚæä" MyArry3(0) = "" MyArry3(1) = "æÇÍÏ" MyArry3(2) = "ÇËäÇä" MyArry3(3) = "ËáÇËÉ" MyArry3(4) = "ÃÑÈÚÉ" MyArry3(5) = "ÎãÓÉ" MyArry3(6) = "ÓÊÉ" MyArry3(7) = "ÓÈÚÉ" MyArry3(8) = "ËãÇäíÉ" MyArry3(9) = "ÊÓÚÉ" '====================== GetNo = Format(TheNo, "000000000000.00") i = 0 Do While i < 15 If i < 12 Then Myno = Mid$(GetNo, i + 1, 3) Else Myno = "0" + Mid$(GetNo, i + 2, 2) End If If (Mid$(Myno, 1, 3)) > 0 Then RdNo = Mid$(Myno, 1, 1) My100 = MyArry1(RdNo) RdNo = Mid$(Myno, 3, 1) My1 = MyArry3(RdNo) RdNo = Mid$(Myno, 2, 1) My10 = MyArry2(RdNo) If Mid$(Myno, 2, 2) = 11 Then My11 = "ÅÍÏì ÚÔÑ" If Mid$(Myno, 2, 2) = 12 Then My12 = "ÅËäì ÚÔÑ" If Mid$(Myno, 2, 2) = 10 Then My10 = "ÚÔÑÉ" If ((Mid$(Myno, 1, 1)) > 0) And ((Mid$(Myno, 2, 2)) > 0) Then My100 = My100 + MyAnd If ((Mid$(Myno, 3, 1)) > 0) And ((Mid$(Myno, 2, 1)) > 1) Then My1 = My1 + MyAnd GetTxt = My100 + My1 + My10 If ((Mid$(Myno, 3, 1)) = 1) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My11 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My11 End If If ((Mid$(Myno, 3, 1)) = 2) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My12 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My12 End If If (i = 0) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then Mybillion = GetTxt + " ãáíÇÑ" Else Mybillion = GetTxt + " ãáíÇÑÇÊ" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " ãáíÇÑ" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " ãáíÇÑÇä" End If End If If (i = 3) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyMillion = GetTxt + " ãáíæä" Else MyMillion = GetTxt + " ãáÇííä" If ((Mid$(Myno, 1, 3)) = 1) Then MyMillion = " ãáíæä" If ((Mid$(Myno, 1, 3)) = 2) Then MyMillion = " ãáíæäÇä" End If End If If (i = 6) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyThou = GetTxt + " ÃáÝ" Else MyThou = GetTxt + " ÂáÇÝ" If ((Mid$(Myno, 3, 1)) = 1) Then MyThou = " ÃáÝ" If ((Mid$(Myno, 3, 1)) = 2) Then MyThou = " ÃáÝÇä" End If End If If (i = 9) And (GetTxt <> "") Then MyHun = GetTxt If (i = 12) And (GetTxt <> "") Then MyFraction = GetTxt End If i = i + 3 Loop If (Mybillion <> "") Then If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd End If If (MyMillion <> "") Then If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd End If If (MyThou <> "") Then If (MyHun <> "") Then MyThou = MyThou + MyAnd End If If MyFraction <> "" Then If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur Else NoToTxt = ReMark + MyFraction + " " + MySubCur End If Else NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur End If End Function ثم ضع المعادلة التاليه في الخليه التي تريد فيها التفقيط =NOTOTXT(A1;"جنيهاً";"قرشاً") جزاك الله خيرا

السلام عليكم الاخ الكريم / فرج بارك الله فيك تقبل خالص تحياتي جزاك الله خيرا

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

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

السلام عليكم الاخ الكريم / نور انور بارك الله فيك اولا لنقل كود الحفظ الي ملفك .... قم بعمل مودل وضع الاكواد التاليه فيه ... Public Rm As Double Public Const C_Con = 60 Public Const Sc_W = "Ex" Public Sub St_A() Rm = Now + TimeSerial(0, 0, C_Con) Application.OnTime EarliestTime:=Rm, Procedure:=Sc_W, Schedule:=True End Sub Sub Ex() Application.DisplayAlerts = False ThisWorkbook.Save Application.DisplayAlerts = True St_A End Sub ثم ضع الاكواد التاليه في حدث الملف ThisWorkbook Private Sub Workbook_Deactivate() Call St_A End Sub Private Sub Workbook_Open() Call St_A End Sub واي استفسار .. او توضيح ... لاتتردد ابدا جزاك الله خيرا

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

السلام عليكم الاخ الكريم / asdawy بارك الله فيك ولكن يجي عليك وضع موضوع جديد لطلب برنامج المرتيات الذي تريده في منتدي الاكسيل او منتدي الاكسيس ليمكن مساعدتك فيما تريد جزاك الله خيرا

السلام عليكم الاخ الكريم / فرج بارك الله فيك طبعا بعد رد الاستاذ الكبير / جمال ... لايوجد رد ولكني احب ان اوضح معلومة عامة هو انه في الملف المرفق في المشاركة رقم 2# يمكنك اخي الكريم الادخال مباشرة في خلايا العمود H دون الاختيار من القائمة المنسدلة ليصبح بذلك لديك الطريقتين الادخال المباشر او الاختيار من القائمة المنسدلة ================================= واليك اخي الكريم الكود التالي يقوم بتنفيذ نفس الوظيفه دون اي قوائم جرب الادخال في العمود A في المرفق .... ويتم وضع الكود في حدث الورقة التي تريد تنفيذ الكود فيها Private Sub Worksheet_Change(ByVal Target As Range) Dim cl As Range For Each cl In Range("A1:A20000") If cl.Value >= 26 And cl.Text <> "غ" Then MsgBox "الرقم / الحرف: " & cl.Value & " لايمكنك ادراجه هنا ", vbExclamation, "خطأ" cl.Value = "": cl.Activate End If Next End Sub جزاك الله خيرا ادخال قيم معينة في عمود معين.rar

السلام عليكم الاخ الكريم / nunu246 بارك الله فيك جزاك الله خيرا

الاخ الحبيب / سعد عابد بارك الله فيك تقبل خالص تحياتي وشكري جزاك الله خيرا

الأخ الكريم / أبو شرف بارك الله فيك وان شاء الله ساعمل علي طلبك ولكن اعذرني بعض الوقت نظرا لضيق الوقت هذه الايام جزاك الله خيرا

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

الاخ الكريم / دكتور محمود ربيع بارك الله فيك وجزيل شكري علي كلماتك الراائعة بالنسبه للطلب الأخير بخصوصو تشغيل الاختصار عند تشغيل الملف قم بوضع الكود في حدث الملف ThisWorkbook كما يلي Private Sub Workbook_Open() Application.OnKey "%{F11}", "" End Sub جزاك الله خيرا

الاخ الكريم / فرج الملف المرفق العمود H اخي الكريم لايقبل الا الارقام من 0 الي 25 وكذلك حرف غ ولايقبل اي شئ آخر ... قم بكتابه ذلك في العمود المحدد ام انك لا تريد data validation نهائيا جزاك الله خيرا

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

الاخ الكريم / أبو شرف الاخ الفاضل / سعد عابد بارك الله فيكم وبالنسبه لنسخ الخلايا علي قدر المستخدم منها 9 او 10 اليكم الملف به الكود مع التعديل ليتناسب مع طلبكم واي تعديلات او استفسارات معكم باذن الله دائما جزاكم الله خيرا كشف حساب-SAMA+++.rar

الاخ الكريم / فرج بارك الله فيك جرب المرفق به المطلوب ... علي حسب فهمي للطلب او قم بارفاق ملف كمثال ارجو ان يفي بطلبك جزاك الله خيرا data validation.rar