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

بسم الله الرحمان الرحيم السلام عليكم جمعة مباركة على الجميع اقدم لكم اليوم طريقة سهلة وعملية لتجميل الازرار في الفورم او حتي في الشيت الطريقة و بكل بساطة تعتمد على تغير نوع الخط ونعتد على اربعة انواع من الخطوط لتحقيق هذا وهذه الاخيرة متوفرة على اغلب الاجهزة الخطوط المستعملة هي wingdigs , wingdings 2 , wingdings 3 , webdings تجدون في المرفق امثلة عملية كما يوجد ايضا ملف PDF يحوي على جميع الارقام والحروف والرموز وما يقابلها عند تغير نوع الخط كل ما عليكم اختيار الشكل الذي تحتاجونه في تصميمكم ملاحظة للأمانة فكرة الموضوع منقولة من احد المواقع الاجنبية كل ما فعلته هو التطبيق جميع الرموز والصورة الممكنة.pdf امثلة عملية.rar تحياتي للجميع

تفضل أخى القول الفصل فى سؤالك تقبل تحياتى جلب الأسماء الفريدة وعددها.rar

الأستاذ / وليد السلام عليكم ورحمة الله وبركاته إليك الملف لعله المطلوب. حساب عدد الساعات اثناء فترة الدوام1.rar

السلام عليكم ورحمة الله وبركاته كل عام وانتم بخير اطلب المسامحة ممن راسلني ولم يجد رد مني هديتي لكم بعد هذه الغيبة Option Explicit '========================================================" ' بسم الله الرحمن الرحيم " '========================================================" ' (دالة تحويل الرقم الى نص باللغة العربية (تفقيط " ' kh_TextNum " '========================================================" 'Num الرقم " '========================================================" 'sex جنس العملة " 'FALSE ( فارغ او صفر مذكر ) " 'TRUE ( أو اي رقم غير الصفر مؤنث ) " '========================================================" 'sNameCurr اسم العملة الرئيسية مفرد " 'pNameCurr اسم العملة الرئيسية جمع " 'NameCurrDec اسم العملة الكسرية " 'Decimal_Count طول الكسر افتراضـياً : بدون اظهار الكسر " '===============================================================================================================================================" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" '===============================================================================================================================================" ' ملاحظات ' (اولاً : العملة الرئيسية مثنى (يقوم بها الكود تلقائيا ' مع ملاحظة اذا اسم العملة ينتهي بالتاء المربوطة ' يجب ان يكتب كذلك وليس بالهاء ' ----------------------- ' ثانياً : اذا كانت العملة الرئيسية مفرد فارغاً تعتبر ' اسماء العملات (الجمع والكسري) فارغة تلقائيا ' ----------------------- 'ثالثاً : الكلمة الابتدائية بامكانك تغييرها او تجعلها فارغة Private Const MyBegTx As String = "فقط " ' "" ' ----------------------- ' MyTNum رابعا : يمكنك التغيير (اضافة,حذف,تحرير) في الثابت ' للفئات الصفرية للرقم ادناه Private Const MyTNum As String = "ألف-آلاف/مليون-ملايين/مليار-مليارات/بليون-بلايين/بليار-بليارات/ترليون-ترليونات/تريليار-تريليارات/كدرليون-كدرليونات" '===============================================================================================================================================" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" '===============================================================================================================================================" Function kh_TextNum(Num As String, Optional sex As Boolean = False, Optional sNameCurr As String = "", Optional pNameCurr As String = "", Optional NameCurrDec As String = "", Optional Decimal_Count As Byte = 2) As String Dim Spp, zt Dim i%, ii%, pr% Dim MyMid$, nCurr$, Txt$, Txt1$, Txt2$ '====================================== If Not IsNumeric(Num) Then GoTo kh_Exit Spp = Split("/" & MyTNum, "/") ii = UBound(Spp) If Num < 0 Then Num = Abs(Num) '====================================== If Val(Num) > Val(String((ii + 1) * 3, "9") & ".999") Then GoTo kh_Exit '====================================== nCurr = sNameCurr & "-" & IIf(pNameCurr = "", sNameCurr, IIf(sNameCurr = "", "", pNameCurr)) '====================================== Txt1 = Format(Num, String((ii + 1) * 3, "0") & ".000") For i = 0 To ii MyMid = Mid(Txt1, (i * 3) + 1, 3) If MyMid Then zt = Mid(Txt1, (i * 3) + 4, Len(Txt1)) zt = IIf(ii - i, Int(zt), zt) Txt2 = IIf(ii - i, Trim(Spp(ii - i)), nCurr) pr = 1 + IIf(ii - i, 1, CInt(sex)) Txt = Txt & IIf(Len(Txt), " و", "") & kh_nText(MyMid, Txt2, pr, zt, CBool(sNameCurr <> "")) End If If i = ii Then If MyMid = 0 Then Txt = Txt & IIf(Len(Txt), " ", "صفر ") & sNameCurr Next '====================================== Txt = MyBegTx & Txt & kh_dText(Num, sNameCurr, NameCurrDec, Decimal_Count) '====================================== kh_Exit: kh_TextNum = Trim(Txt) End Function ' معالجة العدد من 1 الى 999 لكل فئات الرقم Private Function kh_nText(ByVal iNum As String, ByVal oMm As String, ByVal ibs As Integer, ByVal z As Boolean, ByVal tCu As Boolean) As String Dim Sp Dim Num1%, Num2%, Num3% Dim oM$, S$, S1$, nT$, nT0$, nT1$, nT2$ '====================================== Sp = Split("واحد,إحدى,اثنتان,ثلاث,أربع,خمس,ست,سبع,ثمان,تسع,عشر,إحدى ,اثنتا ", ",") '====================================== If ibs Then S = "ة": Sp(1) = Sp(0): Sp(2) = "اثنان": Sp(11) = "أحد ": Sp(12) = "اثنا " Else S1 = "ة" oM = Trim(Split(oMm, "-")(0)) '====================================== Num1 = Left(iNum, 1) Num2 = Right(iNum, 2) Select Case Num1 Case 1: nT0 = "مائة" Case 2: nT0 = "مائتا" & IIf(ibs = 2, IIf(Num2 < 3, "", "ن"), IIf(Num2 = 0 And oM <> "", "", "ن")) Case 3 To 9: nT0 = Sp(Num1) & "مائة" End Select '========================================= Num1 = Right(iNum, 2) Select Case Num1 Case 1, 2: If nT0 <> "" Then If ibs = 2 Then nT0 = nT0 & " " & oM Case 11 To 99: If oM <> "" Then If ibs Then If z Then oM = oM & "اً" End Select '----------------------------------------- Select Case Num1 Case 1 nT = IIf(oM = "", Sp(0) & S1, oM) oM = IIf(ibs <> 2 And oM <> "", Sp(0) & S1, "") Case 2 nT = IIf(oM = "", Sp(Num1), Replace(oM, "ة", "ت") & IIf(z = 0 And ibs = 2 And tCu, "ا", "ان")) oM = IIf(ibs <> 2 And oM <> "", Sp(Num1), "") Case 3 To 10 oM = Trim(Split(oMm, "-")(1)) nT = Sp(Num1) & S Case 11, 12 nT = Sp(Num1) & Sp(10) & S1 Case 13 To 19 nT = Sp(Num1 - 10) & S & " " & Sp(10) & S1 Case 20 To 99 Num2 = Right(Num1, 1) Num3 = Left(Num1, 1) If Num3 = 2 Then nT1 = "عشرون" Else nT1 = Sp(Num3) & "ون" nT2 = Sp(Num2) & IIf(Num2 > 2, S, "") & " و" & nT1 If Num2 = 0 Then nT2 = nT1 nT = nT2 End Select '====================================== S = IIf(nT = "" Or iNum < 100, "", " و") nT = Replace(nT, Sp(8) & "ة", Sp(8) & "ية") kh_nText = Trim(nT0 & S & nT & " " & oM) '====================================== End Function ' معالجة الكسر Private Function kh_dText(ByVal dNum As String, ByVal NCur As String, ByVal Ndec As String, ByVal co As Byte) As String Dim Td$, Td1$ On Error GoTo 1 If NCur = "" Then Ndec = "" Td = Format(Round(CCur(dNum - Int(dNum)), co), "0." & String(co, "0")) If Td = 0 Or Td = 1 Then Td1 = "": GoTo 1 If Len(Ndec) Then Ndec = " " & Ndec: Td1 = Td * CVar("1" & String(co, "0")) Else Ndec = " " & NCur: Td1 = Td Td1 = " و " & Chr(40) & Td1 & Chr(41) & Ndec 1: kh_dText = Td1 End Function دالة تحويل الرقم الى نص عربي.rar ================================================= الملف المعدل: هذا المرفق بامكانية تفقيط الكسر وامكانية ادخال كلمة نهاية النص دالة تحويل الرقم الى نص عربي.rar ================================================= رابط مباشر للملف

بسم الله الرحمن الرحيم اخواني مشرفي واعضاء هذا المنتدى الرائع السلام عليكم ورحمة الله وبركاته يسرني أن اقدم لكم: التقويم المفتوح - اصدار: 1 - 2011 تقويم (هجري/ ميلادي) و (ميلادي/ هجري) مع تحديد ايام المناسبات (الدينية والرسمية والشخصية) السنوية يبدأ من عام 1318هـ الموافق: 1901م حتى عـــام 2452هـ الموافق: 3000م أتمنى ممن له ملاحظة أو اقتراح أن لا يبخل علينا تمنياتي للجميع بالتوفيق وكل عام وانتم بخير التقويم المفتوح 1901 - 3000 اصدار 11.zip

أحياناً لا يسعفني الوقت لمعرفة معادن من هم حولنا ولكن ما أن تحدث لنا مشكلة وتكشف لنا معادنهم النبيلة شكراً اخي العزيز طلعت نعم هو المطلوب

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

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

فكرة رائعة بارك الله فيك

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

حل أخر بالمعادلات تقبلوا تحياتى عد التكرارات فى قائمة.rar

السلام عليكم ورحمة الله أخي الكريم، بمعية أعمدة إضافية (ضرورية) تم تعديل كل المعادلات وبعض التنسيقات في الملف مع معادلات صفيف لجلب الأسماء المكررة حسب عدد التكرارات الذي نختاره في الخلية G9... أرجو أن تلبي هذه التعديلات طلبك.... أخوك بن علية الملف المرفق : تعديل معادلات لعد الاسماء المكررة واستخرجها.rar

السلام عليكم بعد اذن استاذى العزيز //جمال عبدالسميع اخى الكريم صاحب السؤال رايت سؤالك سابقا وقد تم الحل بالمعادلات وبالاكواد عن طريق اساتذه ومبدعين جزاهم الله خيرا ولم يتبقى لى الا ان اقوم بالحل بطريقه اخرى وطريقه طريقة PIVOT TABLE وهى لاتحتاج الى معادلات او اكواد وان تعلمتها ستحبها كثيرا لانها توفر عليك جهدا كبير واليك الحل تقبل تحياتى جلب الأسماء الفريدة وعددها.rar

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

حل أخر بعد حل أخى " محمد الريفى " تقبل تحياتى ترحيل بناء على حالة القيد.rar

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

ومن أجل أخى الحبيب " سامى " صاحب السؤال وإجابة جديدة له وللزملاء ، يمكنة إستخدام هذا الكود لإظهار عدد الأسماء الفريدة فى مدى معين ،ولكنه يقوم بتحديد المدى الذى يريد " عد " الأسماء الفريدة فية Sub gama1() Dim r As Range, e With CreateObject("Scripting.Dictionary") .CompareMode = 1 For Each r In Selection For Each e In Split(Replace(r.Value, " ", "")) .Item(e) = .Item(e) + 1 Next Next MsgBox "عدد الكلمات الفريدة فى المدى المختار: " & Format(.Count) End With End Sub عد الأسماء الفريدة.rar

أنظر لهذا الرابط أخى أعتقد ستجد به ماتريد http://www.officena.net/ib/index.php?showtopic=55486

تفضل أخى لعله " المطلوب " تقبل تحياتى بطاقة موظف.rar

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

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

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

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

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

السلام عليكم هته الفكرة راودتني عندما كنت اصمم برنامج دليل الهاتف على طريقة سامسونج جالكسي لكني لم أنجح حينها في تنفيذها اليوم وصلت الى الطريقة بحمد الله وشكره واردت مشاركتكم بها المهم وصلت الى طريقة تجعل اللون الابيض يختفي من الفورم حيث يصبح شفافا بل منعدم وبهذه الطريقة اصبح يمكن جعل الفورم ياخذ اي شكل نريده كل ما عليك هو وضع هذا الكود في موديل Option Explicit Public Declare Function FWw Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function SWLg Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function DrMBar Lib "user32" Alias "DrawMenuBar" (ByVal hWnd As Long) As Long Public Declare Function SLWA Lib "user32" Alias "SetLayeredWindowAttributes" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, ByVal dwFlags As Long) As Long Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Declare Function ReleaseCapture Lib "user32" () As Long Public hWnd As Long Public Function Rabie_Sk(uf As Object, colors As Variant, Optional Sk As Variant = True) hWnd = FWw(vbNullString, uf.Caption) SWLg hWnd, -16, &H80080080: SWLg hWnd, -20, &H80000: DrMBar hWnd Select Case Sk Case True SLWA hWnd, colors, &H2, &H1 Case False SLWA hWnd, colors, 50, &H2 End Select End Function وفي حدث UserForm_Initialize ضع هذ الكود Rabie_Sk Me, vbWhite, True والباقي عليك في اختيار الشكل الذي تريده لا اطيل عليكم وأترككم مع المرفق تحياتي للجميع اجعل الفورم يأخذ اي شكل تريده.rar

السلام عليكم اعضاء ومشرفين منتدانا الرائع بوجود امثال الاستاذ الكبير ضاحي الغريب حبيت اعمل استمرار لجهود الاخ حسين شاكر (انشاء الله مايطول غيبته علينا ) واهدي لكم عمل الاستاذ ضاحي الغريب بملف نوع pdf شامل لكل دروسة كي لاتضيع المعلومة المفيدة وتعم الفائدة ويارب يعجبكم https://www.dropbox.com/s/421qv3zwr81f2rw/%D8%B4%D8%B1%D8%AD%20%D8%A7%D9%84%D8%A7%D8%B3%D8%AA%D8%A7%D8%B0%20%D8%B6%D8%A7%D8%AD%D9%8A%20%D8%A7%D9%84%D8%BA%D8%B1%D9%8A%D8%A8%20-%20%D8%A7%D9%85%D8%AB%D9%84%D8%A9%20%D8%B9%D9%86%20%D9%83%D9%8A%D9%81%D9%8A%D8%A9%20%D8%A7%D8%B3%D8%AA%D8%AE%D8%AF%D8%A7%D9%85%20%D8%A3%D8%AF%D9%88%D8%A7%D8%AA%20%D8%A7%D9%84%D9%81%D9%88%D8%B1%D9%85.pdf وتقبل الله صيامكم وقيامكم بشهر الخير والفضيلة

و هذا نموذج آخر تقويم سنوات مختلفه فقط اختر السنه و او الشهر المطلوب و كل عام و الجميع بألف خير و عافيه و راحة بال... excel_calendar_v1-3.rar

السلام عليكم اخواني اتت الفكرة بناء علي طلب احد الاخوة وتخطت ذلك لجعلها تقويم لاي سنه و اظهار صورة لكل شهر فكرة البرنامج في الخلية B2 اكتب السنة التي تريد عمل تقويم لها في الخلية A2 اختر الشهر الذي تريد يوجد فولدر مرفق اسمه Pic موضوع به 12 صورة بعدد اشهر السنة و كل صورة باسم الشهر الخاص بها فمثلا يناير صورتة اسمها 1 و هكذا و لابد ان يكون نسق الصورة jpg و عندما تريد تغير الصوره فقط ضعها في هذا الفولدر و سمها باسم الشهر كما سبق التوضيح طبعا بعد الغاء اي صوره تحمل نفس الاسم ارجو التجربة و اخباري النتيجة تحياتي تقويم.rar