Ali Mohamed Ali

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

بارك الله فيك وزادك من فضله ولك بمثل ما دعوت لى وزيادة

يمكنك بذلك استخدام ملف الأستاذ عماد بارك الله فيه

تفضل أخى الكريم تجربة.xlsm

طبعا بالتأكيد كما بصورتك فلا تعمل لابد من وضع علامة صح كما بالصورة فى المربع الصغير . .

تفضل الحل بمعادلات المصفوفة 1الحكام.xlsx

وده امر سهل ان شاء الله -انظر الى الصور . .

تفضل تم الحل بمعادلات المصفوفة استعلام.xlsm

وعليكم السلام تفضل البحث في أكسيل.xlsm

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

وهذا ملف أخر به كود اخر . تحويل الارقام الى حروف.mdb

وعليكم السلام تفضل هذا الكود Function NoToTxt2(TheNo As Double, MyCur As String, MySubCur As String) 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.999 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1 ReMark = "لم يتبقي " Else ReMark = "فقط " End If If TheNo = 0 Then NoToTxt2 = "صفر" 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 = Round(TheNo, 3) GetNo = Format(TheNo, "000000000000.000") I = 0 '=============== Do While I < 16 If I < 12 Then Myno = Mid$(GetNo, I + 1, 3) Else Myno = Mid$(GetNo, I + 2, 3) + "0" ' "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 NoToTxt2 = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur Else NoToTxt2 = ReMark + MyFraction + " " + MySubCur End If Else NoToTxt2 = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur End If End Function

وعليكم السلام يمكنك وضع هذا الكود فى حدث الورقة المراد حماية المعادلات بها Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.HasFormula Then MsgBox "ÇáãÚÇÏáÇÊ áä ÊÙåÑ" 'ActiveSheet.Protect Else 'ActiveSheet.Unprotect End If MyPassword = "123" For Each MySheet In ActiveWorkbook.Sheets MySheet.Protect _ Password:=MyPassword, _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True, _ AllowFormattingCells:=True, AllowFormattingColumns:=True, _ AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _ :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _ AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _ AllowUsingPivotTables:=True, _ UserInterfaceOnly:=False Next MySheet End Sub

تفضل تعديل على الكود - الترحيل على اساس شروط ثلاث -استثناء بعض الارقام2.xlsm

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

بعد اذن استاذى الكريم سليم تفضل sales.xlsx

وعليكم السلام لك ما طلبت تعديل على الكود - الترحيل على اساس شروط ثلاث.xlsm

وعليكم السلام تفضل 2.xlsm

تفضل لتحليل الاختبارات للمرحلة المتوسطة والثانوية.xls

اشرح ما تريده بالضبط على الملف مع الإستعانة بالصور للتوضيح

وعليكم السلام اخى الكريم اهلا بك فى المنتدى تفضل الملف بدون حماية لتحليل الاختبارات للمرحلة المتوسطة والثانوية.xls

بعد اذن استاذنا عماد وذلك بكتابة السطر الأول داخل الخلية ثم الضغط على Alt+Enter وكتابة السطر الثانى جزاك الله كل خير

وذلك بجعل التنسيق كما بالصورة بارك الله فيك

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

بارك الله فيك ولك بمثل ما دعوت لى وزيادة-والحمد لله الذى بنعمته تتم الصالحات