يوسف عطا

جزيت خيراً سالم بك تفق معك وأؤيدك فى طلبك

أرجو من الأستاذ أيسم والأستاذ خبور التفضل بزيارة هذا الرابط وفيه طلب مشابه ولكم جزيل الشكر http://www.officena.net/ib/index.php?showtopic=29166 وربنا الموفق

عوداً حميداً

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

أولاً يجب أن تكون الصورة بإمتداد جى بى جى تحت مكان الكتابة تجد كلمة تصفح إضغط عليها وإذهب إلى مكان حفظ الصورة المراد رفعها حددها إضغط على تحميل إنتظر ثوانى حتى ظهور عبارة تم تحميل الملف بنجاح إرسل مشاركتك الف مبروك الصورة تظهر فى مشاركتك الآن مثل هذه

أعتذر إنقطعت الكهرباء أثناء وضع المشاركة وإعتقدت أنه تم الرفع وهذا هو الملف أعتذر مرة أخرى ___________________________________________________.rar

أرجو أن يكون هذا ما تريد الملف مرفق Bok1.rar

عزيزى الفاضل لاحظت أن المادة فى الورقة 1 لها عمودين فقط بينما فى الورقة 2 لها 3 أعمدة لابد من تساوى عدد الأعمدة فى كل مادة فى الورقة 1 نظيرتها فى الورقة الأخرى بحيث إدراج مادة جديدة فى ورقة 1 يؤدى إلى إدراج نفس المادة فى نفس عدد الأعمدة فى الورقة 2 وجارى عمل اللازم

جارى العمل على الملف

عزيزى لابد أن ترفع ملفك حتى يعرف الأخوة ماذا تريد بالضبط لو كان ملفك أقل من 1000 كيلو بايت يمكنك رفعه مباشرة للمنتدى من المرفقات ولو كان أكبر من 1000 كيلوبايت يمكنك رفعه على هذا الرابط وبعد رفعه سيظهر لك لينك تنسخه وتلصقه هنا فى الموضوع ليظهر للزملاء الذين يريدون تحميله هذا هو الرابط youssef.4shared.com أو من هنا

مشكور

ما حجم هذه الأداة قبل التثبيت وما المساحة التى تأخذها من البارتشن سى بعد التثبيت ؟؟؟ أشكرك على ردك مقدماً

مشكور وفقك الله

أعتقد وخبرتى أقل من متواضعة فى هذا الموضوع أنه يمكن عمل ماكرو طباعة الكل ويتم فيه تحديد نطاق الطباعة عن طريق عدد الصفحات فلو عندك 100 شهادة والصفحة تطبع فيها 3 شهادات إذن فأنت ستطبع 34 صفحة وبالتالى يمكنك تحديد نطاق الطباعة فى البرنت أوبشن اثناء عمل الماكرو لطباعة صفحات من 1 : 34 وعند الرغبة فى طباعة جميع الشهادات يمكنك تشغيل الماكرو فلا تتذمر الطابعة وتسمع كلامك وتنفذه بالضبط أرجو أن أكون أحسنت فى عرض الحل

فى الملف المرفق فى شيت النتيجة هناك عدد 189 طالبة كل طالبة لها بيانات ودرجات فى صفين ويوجد دمج فى بعض الخلايا تبدأ الصفوف من صف رقم 10 فالطالبة الأولى بياناتها فى صفين رقم 10 و 11 والتالية 12 و 13 وهكذا توجد 24 طالبة ناجحة ومنقولة للصف الثالث خلية النتيجة ملونة بالأخضر توجد 134 طالبة راسبة و لها حق الإعادة خلية النتيجة ملونة بالأحمر توجد 31 طالبة راسبة وليس لها حق الإعادة خلية نتائجهن ملونة بلون رمادى المطلوب ترحيل كل فئة إلى شيت خاص بها داخل نفس الملف مع مراعاة ترحيل جميع البيانات بنفس تنسيقها أى الخلايا المدمجة ترحل مدمجة والخلايا الغير مدمجة ترحل كما هى غير مدمجة أرجو سرعة الرد للضرورة ولكم جزيل الشكر الملف مرفق

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

مشكور

جهد مشكور عليه

قد يكون هذا هو الكود الذى ذكره الأخ جودة أعتذر عزيزى ابو تامر لم أرى مشاركتك إلا بعد أن كتبت مشاركتى تقبل إعتذارى [ Option Explicit Public Const vArabic As Byte = 1 Public Const vEnglish As Byte = 2 Public Const vMale As Byte = 0 Public Const vFemale As Byte = 1 Private Function myNz(ByVal InValue, Optional ByVal ValueIfNull = Null) myNz = IIf(IsNull(InValue), IIf(IsNull(ValueIfNull), Empty, ValueIfNull), InValue) End Function Private Function Delete(S As String, Index As Integer, Count As Integer) As String Delete = Left(S, Index - 1) + _ Mid(S, Index + Count, Len(S)) End Function Private Function Insert(Source, S As String, Index As Integer) As String Dim LPart As String Dim RPart As String LPart = Left(S, Index - 1) RPart = Mid(S, Index, Len(S)) Insert = LPart & Source & RPart End Function Private Function AddAnd(s1 As String, S2 As String, S3 As String, _ And_ As String, Lang As Byte) As String Dim InAnd_ As String Dim CollectS As String If Lang = vArabic Then InAnd_ = " " + And_ Else InAnd_ = And_ + " " If (s1 <> "") And (S2 <> "") Then And_ = InAnd_ Else And_ = "" CollectS = s1 + And_ + S2 If (CollectS <> "") And (S3 <> "") Then And_ = InAnd_ Else And_ = "" AddAnd = CollectS + And_ + S3 End Function Private Function S2Double(Single_ As Variant, Sex As Byte) As String Dim LLeter As Integer Dim K As Byte Dim Sngl_1 As String Dim Sngl_2 As String K = InStr(1, Single_ & " ", " ") Sngl_1 = Left(Single_, K - 1) Sngl_2 = "" If K < Len(Single_) Then Sngl_2 = Mid(Single_, K + 1, Len(Single_)) End If If Sngl_2 <> "" Then If Right(Sngl_2, 1) = "ة" Then Sngl_2 = Left(Sngl_2, Len(Sngl_2) - 1) & "تان" Else Sngl_2 = Sngl_2 & "ان" End If End If If Sngl_1 <> "" Then LLeter = Asc(Right(Sngl_1, 1)) Select Case LLeter Case 201 ' "ة" Sngl_1 = Left(Sngl_1, Len(Sngl_1) - 1) & "تان" Case 236 ' "ى" Sngl_1 = Left(Sngl_1, Len(Sngl_1) - 1) & "يان" Case 199 ' "ا" Sngl_1 = Left(Sngl_1, Len(Sngl_1) - 1) & "وان" Case 193 ' "ء" If Right(Sngl_1, 2) = "اء" Then If Sex = 1 Then Sngl_1 = Left(Sngl_1, Len(Sngl_1) - 1) & "وان" Else Sngl_1 = Sngl_1 & "ان" End If End If Case Else If Sngl_1 <> "" Then Sngl_1 = Sngl_1 & "ان" End Select If Sngl_2 <> "" Then S2Double = Sngl_1 & " " & Sngl_2 Else S2Double = Sngl_1 End If End Function Private Function Fmale(Num As Byte, Sex As Byte, Female()) As String Dim Two(1 To 4) As String Dim InSex As Byte Two(1) = "أحد" Two(2) = "اثنان" Two(3) = "إحدى" Two(4) = "ة" Select Case Sex Case vMale: Select Case Num Case 1: Fmale = Mid(Female(1), 1, 4) Case 2: Fmale = Two(2) Case 8: Fmale = Female(Num) + "ي" + Two(4) Case 3 To 7, 9, 10: Fmale = Female(Num) + Two(4) Case 11: Fmale = Two(1) + " " + Female(10) Case 12: Fmale = Mid(Two(2), 1, 4) + " " + Female(10) Case 13 To 19: Fmale = Female(Num - 10) + Two(4) + " " + Female(10) End Select Case vFemale: Select Case Num Case 1 To 10: Fmale = Female(Num) Case 11: Fmale = Two(3) + " " + Female(10) + Two(4) Case 12: Fmale = Mid(Female(2), 1, 5) + " " + Female(10) + Two(4) Case 13 To 19: Fmale = Female(Num - 10) + " " + Female(10) + Two(4) End Select End Select End Function Private Function Tens(Num As Byte, Female()) As String Const Noon = "ون" Select Case Num Case 2: Tens = Female(10) + Noon Case 3 To 9: Tens = Female(Num) + Noon End Select End Function Private Function Hunds(Num As Byte, Female()) As String Const Hund = "مائة" Select Case Num Case 1: Hunds = Hund Case 2: Hunds = Mid(Hund, 1, 3) + Mid(Female(2), 4, 3) Case 3 To 9: Hunds = Female(Num) + Hund End Select End Function Private Function Tenteen(Num As Byte, ETens()) As String Const een = "een" Num = Num Mod 10 Select Case Num Case 3 To 9: Tenteen = Mid(ETens(Num), 1, Len(ETens(Num)) - 1) + een End Select End Function Private Function EHunds(Num As Byte, ESingle()) As String EHunds = ESingle(Num) + " hundred" End Function Private Function ReFormat(InNum As Double, Dec As Byte) As Double Dim NewFormat As String If Dec > 0 Then NewFormat = "0." Else NewFormat = "0" NewFormat = NewFormat & String(Dec, "0") ReFormat = Format(InNum, NewFormat) End Function Private Function ReStr(InNum As String) As String Dim K As Byte Dim Digits As Byte Dim Num_ As String Num_ = LTrim(InNum) K = InStr(1, Num_, "E+", 1) If K > 0 Then Digits = Val(Mid(Num_, K + 2, 3)) Num_ = Left(Num_, K - 1) Num_ = Delete(Num_, 2, 1) Do While Len(Num_) - 1 < Digits Num_ = Insert(Num_, "0", 1) Loop End If ReStr = Num_ End Function Private Function AOnly(Num_ As String, FracS As String, Single_ As String, _ Plural As String, Parts As Byte, Sex As Byte, Dec As Byte) As String Const And_ As String * 1 = "و" Const Lang = vArabic Dim PartNum(0 To 5) As Long Dim Result1(0 To 5) As String Dim Parts_(0 To 11) As String Dim Female(1 To 10) As Variant Dim TempI As Byte Dim Sex2 As Byte Dim K As Byte Dim Only_ As String Dim OnlyPart As String Dim Part_ As String Dim TempS As String Dim Sngl_1 As String Dim Sngl_2 As String Dim N1 As Byte, N2 As Byte, N3 As Byte Dim N1_ As String, N2_ As String, N3_ As String If Val(Num_) = 0 Then If FracS = "" Then AOnly = RTrim("صفر " & Single_) Else AOnly = FracS & " " & Single_ End If Exit Function End If Female(1) = "واحدة" Female(2) = "اثنتان" Female(3) = "ثلاث" Female(4) = "أربع" Female(5) = "خمس" Female(6) = "ست" Female(7) = "سبع" Female(8) = "ثمان" Female(9) = "تسع" Female(10) = "عشر" Parts_(0) = "" Parts_(1) = "ألف" Parts_(2) = "مليون" Parts_(3) = "مليار" Parts_(4) = "ترليون" Parts_(5) = "كدرليون" Parts_(6) = "" Parts_(7) = "آلاف" Parts_(8) = "ملايين" Parts_(9) = "مليارات" Parts_(10) = "ترليونات" Parts_(11) = "كدرليونات" K = InStr(1, Single_ & " ", " ") Sngl_1 = Left(Single_, K - 1) Sngl_2 = "" If K < Len(Single_) Then Sngl_2 = Mid(Single_, K + 1, Len(Single_)) End If For K = 0 To Parts - 1 PartNum(K) = Val(Mid(Num_, (K * 3) + 1, 3)) Next K Sex2 = Sex For K = 0 To (Parts - 1) If K = (Parts - 1) Then Sex = Sex2 Else Sex = vMale TempS = Mid(Num_, (K * 3) + 1, 3) TempI = Val(Mid(TempS, 2, 2)) N1 = Val(Mid(TempS, 1, 1)) N2 = Val(Mid(TempS, 2, 1)) N3 = Val(Mid(TempS, 3, 1)) '{------------------------------------------} N1_ = "": N2_ = "": N3_ = "" If N1 > 0 Then N1_ = Hunds(CByte(N1), Female()) If PartNum(K) = 200 Then N1_ = Mid(N1_, 1, Len(N1_) - 1) Select Case TempI Case 1 To 2: If K = Parts - 1 Then If FracS <> "" Then N3_ = Fmale(N3, CByte(Sex), Female()) 'Sex Case 3 To 19: N3_ = Fmale(TempI, CByte(Sex), Female()) Case 20 To 99: N2_ = Tens(CByte(N2), Female()) If N3 > 0 Then N3_ = Fmale(N3, CByte(Sex), Female()) If (N3 Mod 10 = 1) And (Sex = vFemale) Then N3_ = "إحدى" End Select OnlyPart = AddAnd(N1_, N3_, N2_, And_, Lang) '{------------------------------------------} If PartNum(K) > 100 Then Select Case TempI Case 1, 2: OnlyPart = AddAnd(OnlyPart, Parts_(Parts - K - 1), "", "", Lang) End Select End If '{------------------------------------------} Part_ = "" If PartNum(K) > 0 Then Part_ = Parts_(Parts - K - 1) If Part_ <> "" Then Select Case TempI Case 2: Part_ = Part_ + "ان" Case 3 To 10: Part_ = Parts_((Parts - K - 1) + 6) Case 11 To 99: Part_ = Part_ + "ا" End Select End If End If '{------------------------------------------} If Part_ <> "" Then If TempI >= 1 And TempI <= 2 Then OnlyPart = AddAnd(OnlyPart, Part_, "", And_, Lang) Else OnlyPart = AddAnd(OnlyPart, Part_, "", "", Lang) End If End If Result1(K) = (OnlyPart) Next K '{------------------------------------------} N1_ = AddAnd(Result1(0), Result1(1), Result1(2), And_, Lang) N2_ = AddAnd(Result1(3), Result1(4), Result1(5), And_, Lang) Only_ = AddAnd(N1_, N2_, "", And_, Lang) If FracS <> "" Then If Only_ <> "" Then FracS = " " + FracS Only_ = AddAnd(Only_, FracS, "", And_, Lang) End If If Only_ <> "" Then If Mid(Only_, Len(Only_), 1) = "ا" Then If Mid(Only_, Len(Only_) - 1, 2) <> "تا" Then Only_ = Mid(Only_, 1, Len(Only_) - 1) End If End If If TempS = "000" Then If Mid(Only_, Len(Only_) - 1, 2) = "ان" Then Only_ = Mid(Only_, 1, Len(Only_) - 1) End If End If End If '{------------------------------------------} If FracS = "" Then Select Case TempI Case 0: If Only_ <> "" Then Only_ = AddAnd(Only_, Single_, "", "", Lang) Case 1: Only_ = AddAnd(Only_, AddAnd(Single_, Fmale(1, CByte(Sex), Female()), "", "", Lang), "", And_, Lang) Case 2: Only_ = AddAnd(Only_, AddAnd(S2Double(Single_, CByte(Sex)), Fmale(2, CByte(Sex), Female()), "", "", Lang), "", And_, Lang) Case 3 To 10: If Sngl_2 <> "" Then If Right(Sngl_2, 1) = "ة" Then Only_ = AddAnd(Only_, Plural, Sngl_2, "", Lang) Else Only_ = AddAnd(Only_, Plural, Sngl_2 & "ة", "", Lang) End If Else Only_ = AddAnd(Only_, Plural, "", "", Lang) End If Case 11 To 99: If Sngl_1 <> "" Then Only_ = AddAnd(Only_, Sngl_1, "", "", Lang) N1_ = Mid(Only_, Len(Only_), 1) Select Case N1_ Case "ة", "ى", "ا" Case Else Only_ = Only_ + "ا" End Select N1_ = Mid(Only_, Len(Only_) - 2, 3) 'هذا الشرط لحل مشكلة عدم التمييز بين "ء" و "ل" 2002/08/24 If N1_ = "اءا" And Asc(Right(Sngl_1, 1)) = 193 Then Only_ = Left(Only_, Len(Only_) - 1) End If If Sngl_2 <> "" Then If Right(Only_, 1) = "ا" Then Only_ = AddAnd(Only_, Sngl_2 & "ا", "", "", Lang) Else Only_ = AddAnd(Only_, Sngl_2, "", "", Lang) End If Else Only_ = AddAnd(Only_, Sngl_2, "", "", Lang) End If End If End Select Else Only_ = AddAnd(Only_, Sngl_1, Sngl_2, "", Lang) End If AOnly = (Only_) End Function Private Function EOnly(Num_ As String, FracS As String, Single_ As String, _ Plural As String, Parts As Byte, Dec As Byte) As String Const Lang = vEnglish Dim ESingle(1 To 12) As Variant Dim ETens(2 To 9) As Variant Dim EParts_(0 To 5) As String Dim PartNum(0 To 5) As Long Dim Result1(0 To 5) As String Dim TempS As String Dim TempI As Byte Dim Sex2 As Byte Dim OnlyPart As String Dim Part_ As String Dim Only_ As String Dim Leng As Integer Dim K As Integer Dim N1 As Byte, N2 As Byte, N3 As Byte Dim N1_ As String, N2_ As String, N3_ As String If Val(Num_) = 0 Then If FracS = "" Then 'EOnly = LTrim(Single_ & " zero") EOnly = RTrim("zero " & Single_) Else EOnly = Single_ & " " & FracS End If Exit Function End If ESingle(1) = "one" ESingle(2) = "two" ESingle(3) = "three" ESingle(4) = "four" ESingle(5) = "five" ESingle(6) = "six" ESingle(7) = "seven" ESingle(8) = "eight" ESingle(9) = "nine" ESingle(10) = "ten" ESingle(11) = "eleven" ESingle(12) = "twelve" ETens(2) = "twenty" ETens(3) = "thirty" ETens(4) = "forty" ETens(5) = "fifty" ETens(6) = "sixty" ETens(7) = "seventy" ETens(8) = "eighty" ETens(9) = "ninety" EParts_(0) = "" EParts_(1) = "thousund" EParts_(2) = "million" EParts_(3) = "billion" EParts_(4) = "trillion" EParts_(5) = "quadrillion" For K = 0 To Parts - 1 PartNum(K) = Val(Mid(Num_, (K * 3) + 1, 3)) Next K For K = 0 To (Parts - 1) TempS = Mid(Num_, (K * 3) + 1, 3) TempI = Val(Mid(TempS, 2, 2)) N1 = Val(Mid(TempS, 1, 1)) N2 = Val(Mid(TempS, 2, 1)) N3 = Val(Mid(TempS, 3, 1)) '{------------------------------------------} N1_ = "": N2_ = "": N3_ = "" If N1 > 0 Then N1_ = EHunds(CByte(N1), ESingle()) Select Case TempI Case 1 To 12: N3_ = ESingle(TempI) Case 13 To 19: If N3 > 0 Then N3_ = Tenteen(CByte(TempI), ETens()) Case 20 To 99: N2_ = ETens(N2) If N3 > 0 Then N3_ = N2_ + "-" + ESingle(N3) N2_ = "" End If End Select OnlyPart = AddAnd(N1_, N2_, N3_, "", Lang) '{------------------------------------------} Part_ = "" If PartNum(K) > 0 Then Part_ = EParts_(Parts - K - 1) If Part_ <> "" Then Part_ = EParts_((Parts - K - 1)) End If Result1(K) = AddAnd(OnlyPart, Part_, "", "", Lang) Next K '{------------------------------------------} N1_ = AddAnd(Result1(0), Result1(1), Result1(2), "", Lang) N2_ = AddAnd(Result1(3), Result1(4), Result1(5), "", Lang) Only_ = AddAnd(N1_, N2_, "", "", Lang) Leng = Len(Only_) Only_ = AddAnd(Only_, FracS, "", " and", Lang) If Only_ <> "" Then 'Only_ = AddAnd(Single_, Only_, "", "", Lang) If Val(Num_) = 1 Then Only_ = AddAnd(Only_, Single_, "", "", Lang) Else Only_ = AddAnd(Only_, Plural, "", "", Lang) End If EOnly = Only_ End If End Function Private Function S_Only(InNum As Variant, Lang As Byte, FracType As Byte) As Variant Dim Num_ As String Dim K As Byte Dim Dec As Byte Dim FType As Byte If IsNull(InNum) Then S_Only = Null Exit Function End If Num_ = Str(InNum) K = InStr(1, Num_, ".", 1) If K > 0 Then Dec = Len(Num_) - K If Dec < 2 Then Dec = 2 Else Dec = 0 End If FType = FracType If FType <> 2 Then FType = 1 S_Only = B_Only(InNum, Lang, 0, Dec, "", "", 0, "", "", FType) End Function Private Function B_Only(InNum As Variant, Lang As Byte, Sex As Byte, Dec As Byte, _ Single_ As String, Plural As String, _ FSex As Byte, SFrac As String, PFrac As String, _ FracType As Byte) As Variant Dim Leng As Byte Dim Parts As Byte Dim K As Byte Dim FracVal As Double Dim Num_ As String Dim FracS As String Dim FracNum As String Dim Only As String Dim And_ As String If IsNull(InNum) Then B_Only = Null Exit Function End If Num_ = Str(InNum) If InStr(1, Num_, "E+", 1) > 0 Then Num_ = ReStr(Num_) FracVal = 0 GoTo DoProcess End If Num_ = ReFormat(Val(InNum), Dec) K = InStr(1, Num_, ".", 1) If K > 0 Then FracS = "0" & Mid(Num_, K, Dec + 1) Else FracS = "" FracVal = Val(FracS) Num_ = Trim(Str(Fix(InNum))) Do While Len(FracS) < Dec + 2 FracS = Insert(FracS, "0", 1) Loop DoProcess: If FracVal = 0 Then FracS = "" FracNum = Trim(Mid(FracS, 3, Len(FracS))) If FracS <> "" Then Select Case FracType Case 2 Select Case Lang Case vArabic: FracS = "1" & String(Dec, "0") & "/" & CDbl(Format(FracNum, String(Dec, "0"))) Case vEnglish: FracS = CDbl(Format(FracNum, String(Dec, "0"))) & "/" & "1" & String(Dec, "0") End Select Case 3 FracS = CLng(FracNum) & " " & SFrac 'If Lang = vEnglish And CDbl(FracNum) > 1 Then FracS = FracS & "(s)" Case 4 Leng = Len(FracNum) Parts = Fix((Leng + 2) / 3) For K = 1 To (Parts * 3) - Leng FracNum = Insert("0", FracNum, 1) Next K Select Case Lang Case vArabic: FracS = AOnly(FracNum, "", SFrac, PFrac, Parts, FSex, FracType) Case vEnglish: 'FracS = EOnly(FracNum, "", "", "", Parts, 0) & " " & SFrac FracS = EOnly(FracNum, "", SFrac, PFrac, Parts, 0) '& " " & SFrac 'If CDbl(FracNum) > 1 Then FracS = FracS & "(s)" End Select End Select End If Leng = Len(Num_) Parts = Fix((Leng + 2) / 3) For K = 1 To (Parts * 3) - Leng Num_ = Insert("0", Num_, 1) Next K If Len(Num_) > 18 Then B_Only = InNum Exit Function End If Select Case FracType Case 1, 2 Select Case Lang Case vArabic: Only = AOnly(Num_, FracS, Single_, Plural, Parts, Sex, Dec) Case vEnglish: Only = EOnly(Num_, FracS, Single_, Plural, Parts, Dec) End Select Case 3, 4 Select Case Lang Case vArabic: Only = AOnly(Num_, "", Single_, Plural, Parts, Sex, Dec) If CDbl(Num_) = 0 And FracS <> "" Then Only = "" If FracType = 3 Then And_ = "و " Else And_ = "و" If FracS <> "" Then Only = AddAnd(Only, FracS, "", And_, CByte(Lang)) Case vEnglish: Only = EOnly(Num_, "", Single_, Plural, Parts, Dec) If CDbl(Num_) = 0 And FracS <> "" Then Only = "" If FracS <> "" Then Only = AddAnd(Only, FracS, "", " and", CByte(Lang)) End Select End Select If Only <> "" Then Select Case Lang 'Case vArabic: B_Only = "فقط " & Only Case vArabic: B_Only = Only & " فقط" 'Case vEnglish: B_Only = Only & " only" Case vEnglish: B_Only = "Only " & Only End Select End If End Function Function ArbNum2Text(ByVal InNum, _ Optional ByVal DecimalPlaces = Null, _ Optional ByVal FractionType = 1, _ Optional ByVal CurrencySingle = "", _ Optional ByVal CurrencyPlural = "", _ Optional ByVal CurrencySex = 0, _ Optional ByVal FractionSingle = "", _ Optional ByVal FractionPlural = "", _ Optional ByVal FractionSex = 0) As Variant Dim Negative As String If IsNull(InNum) Then ArbNum2Text = Null Exit Function Else If InNum < 0 Then InNum = Abs(InNum) Negative = "سالب " End If End If If IsNull(FractionType) Then FractionType = 1 If myNz(CurrencySingle) = Empty Or myNz(CurrencyPlural) = Empty Then If Not IsNull(DecimalPlaces) Then InNum = ReFormat(CDbl(InNum), CByte(DecimalPlaces)) End If ArbNum2Text = Negative & S_Only(InNum, vArabic, CByte(FractionType)) Exit Function End If If IsNull(DecimalPlaces) Then DecimalPlaces = 3 If InNum <> Fix(InNum) Then If myNz(FractionSingle) = Empty Or myNz(FractionPlural) = Empty Then If FractionType > 2 Then FractionType = 1 End If End If ArbNum2Text = Negative & _ B_Only(CDbl(myNz(InNum)), vArabic, CByte(myNz(CurrencySex)), _ CByte(myNz(DecimalPlaces)), CStr(myNz(CurrencySingle)), _ CStr(myNz(CurrencyPlural)), CByte(myNz(FractionSex)), _ CStr(myNz(FractionSingle)), CStr(myNz(FractionPlural)), _ CByte(myNz(FractionType))) '-- تعديل خاص لأحد أعضاء منتدى أوفيسنا --------------------------------- If CStr(myNz(CurrencySingle)) = "درجة" And _ CStr(myNz(FractionSingle)) = "جزء" Then Dim Grade As String Dim FracS As String Dim Pos As Integer Grade = Negative & _ B_Only(CDbl(myNz(InNum)), vArabic, CByte(myNz(CurrencySex)), _ CByte(myNz(DecimalPlaces)), CStr(myNz(CurrencySingle)), _ CStr(myNz(CurrencyPlural)), CByte(myNz(FractionSex)), _ CStr(myNz(FractionSingle)), CStr(myNz(FractionPlural)), _ CByte(myNz(FractionType))) Select Case CDbl(myNz(InNum)) - Fix(CDbl(myNz(InNum))) Case 0: Case 0.25: FracS = IIf(Fix(CDbl(myNz(InNum))) = 0, "ربع درجة فقط", "ربع فقط") Case 0.5: FracS = IIf(Fix(CDbl(myNz(InNum))) = 0, "نصف درجة فقط", "نصف فقط") Case 0.75: FracS = IIf(Fix(CDbl(myNz(InNum))) = 0, "ثلاثة أرباع درجة فقط", "ثلاثة أرباع فقط") Case Else: FracS = " " & CDbl(myNz(InNum)) - Fix(CDbl(myNz(InNum))) & " فقط" End Select If FracS <> "" Then Pos = InStr(1, Grade, " و ") If Pos > 0 Then Grade = Left(Grade, Pos + 1) & FracS Else Grade = FracS End If End If Pos = InStr(1, Grade, "درجة واحدة") If Pos > 0 Then Grade = Left(Grade, Pos + 4) & Mid(Grade, Pos + 11) Pos = InStr(1, Grade, "درجتان اثنتان") If Pos > 0 Then Grade = Left(Grade, Pos + 6) & Mid(Grade, Pos + 14) If CDbl(myNz(InNum)) = 0 Then Grade = "صفر" ArbNum2Text = Grade End If '-- نهاية التعديل ------------------------------------------------------- End Function Function EngNum2Text(ByVal InNum, _ Optional ByVal DecimalPlaces = Null, _ Optional ByVal FractionType = 1, _ Optional ByVal CurrencySingle = "", _ Optional ByVal CurrencyPlural = "", _ Optional ByVal FractionSingle = "", _ Optional ByVal FractionPlural = "") As Variant Dim Negative As String If IsNull(InNum) Then EngNum2Text = Null Exit Function Else If InNum < 0 Then InNum = Abs(InNum) Negative = "Negative only " Else Negative = "Only " End If End If If IsNull(FractionType) Then FractionType = 1 If myNz(CurrencyPlural) = Empty Then CurrencyPlural = CurrencySingle '& "(s)" If myNz(FractionPlural) = Empty Then FractionPlural = FractionSingle '& "(s)" If myNz(CurrencySingle) = Empty Then If Not IsNull(DecimalPlaces) Then InNum = ReFormat(CDbl(InNum), CByte(DecimalPlaces)) End If EngNum2Text = Negative & S_Only(InNum, vEnglish, CByte(FractionType)) Exit Function End If If IsNull(DecimalPlaces) Then DecimalPlaces = 3 If InNum <> Fix(InNum) Then If myNz(FractionSingle) = Empty Then If FractionType > 2 Then FractionType = 1 End If End If EngNum2Text = Negative & Mid( _ B_Only(CDbl(myNz(InNum)), vEnglish, 0, _ CByte(myNz(DecimalPlaces)), CStr(myNz(CurrencySingle)), _ CStr(myNz(CurrencyPlural)), 0, _ CStr(myNz(FractionSingle)), CStr(myNz(FractionPlural)), _ CByte(myNz(FractionType))), 6) End Function

الله ينور سالم بك عاوزين نكمل بقى باقى العمليات الحسابية بنفس الطريقة موفق

مشكور على هذا العمل الرائع

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

هل هذه الدالة تصلح للمثال التالى بفرض أنها فى الخلية C1 إذا كانت الخلية B1 ="راسب" أو "راسبة" وكانت الخلية A1 ="باق"أو"باقية" يكتب "راسب" أو "راسبة" وليس له حق الإعادة وإذا كانت الخلية B1 ="ناجح" أو " ناجحة" يكتب "ناجح" أو "ناجحة" ومنقول للصف الأعلى هل تصلح لحل الفرضيات السابقة ؟ أقصد IF OR

عندى سؤال ماهى ضرورة معرفة رقم السيريال نمبر للهارد ؟؟ الف شكر

الف شكر أستاذ صفوت بصراحة أفضل معادلة شفتها لتفقيط الدرجات عندى سؤال ساعات فى أولى ثانوى بتكون الدرجات بجزء من عشرة يعنى مثلاً ممكن المجموع يبقى 212.8 هل يمكن أن يظهر فى التفقيط هكذا مائتان وإثنا عشر درجة وثمان أجزاء من عشرة من الدرجة فقط هل يمكن ذلك ؟؟ الف شكر