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

وعليكم السلام ورحمة الله وبركاته الكود Sub ExtractAbsentees() Dim ws As Worksheet Dim lastRow As Long, lastCol As Long Dim i As Long, j As Long Dim outputRow As Long Set ws = ThisWorkbook.Sheets("SHEET1") lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row lastCol = ws.Cells(4, ws.Columns.Count).End(xlToLeft).Column outputRow = 5 For i = 5 To lastRow For j = 4 To lastCol If ws.Cells(i, j).Value = "A" Then ws.Cells(outputRow, 15).Value = ws.Cells(i, 2).Value ws.Cells(outputRow, 16).Value = ws.Cells(4, j).Value outputRow = outputRow + 1 End If Next j Next i End Sub الملف الغياب.xlsb

بداية يجب تفعيل هذه المكتبات لديك ..... KAN-picutre.rar

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) هذه المرة دعوة لتجربة لعبة المتاهة Maze لأول مرة من خلال آكسيس ميزات اللعبة :- التحكم الكامل من خلال الأسهم في لوحة المفاتيح . تجميع النقاط كلما التهمت الشخصية عدداً أكبر من ( ) . تخسر إذا لامست هذا الكائن في اللعبة ( ) عند طلب المساعدة باستخدام ( ) فإنه سيتم خصم 10 نقاط من رصيد النقاط التي قمت بتجميعها . اللعبة في إصدارها الأول حالياً وسيكون قريباً الكثير من المستويات في اللعب ، وهذه فقط دعوة لتجربتها وإفادتي بآرائكم حول تطويرها وتحديثها وأترككم مع ملف التحميل : Maze Game.zip

تفضلي : التحكم بالمسافة بين السطور في التقرير.accdb

السلام عليكم كيف الحال فكره سريعة تعرض تنبيهات للسدادات المتأخرة او الالتزامات التي اوشكت على الدفع New Microsoft Excel Worksheet.xlsm

اخي @mahmoud nasr alhasany خاصية ColumnHeads = True في عنصر التحكم ListBox لا تعمل إلا إذا كانت البيانات مرتبطة مباشرة بنطاق خلايا من ورقة العمل باستخدام خاصية RowSource عندما تستخدم الطريقة AddItem لإضافة البيانات يدويا لن يتم عرض رؤوس الأعمدة حتى لو قمت بتعيين ColumnHeads = True حاول إضافة رؤوس الأعمدة باستخدام عناصر Label بدلا من الاعتماد على رؤوس الأعمدة داخل الـ ListBox يمكنك تحديدها داخل كود تهيئة اليوزرفورم بعد اظافة عناصر label جديدة بعدد العناوين المرغوب عرضها وتسميتها بإسم مختلف لكي لا يتعارض الكود مع العناصر السابقة مثلا (hrd1- hrd2-...-hrd6) Private Sub UserForm_Initialize() 'الكود الخاص بك Dim arr As Variant arr = Array("كود", "صنف", "سعر", "كمية المخزون", "اسم المخزن", "تاريخ نهاية الصنف") For i = 1 To 6 Me("hrd" & i).Caption = arr(i - 1) Next i End Sub وتعديل الكود على Private Sub CommandButton1_Click() With ListBox2 .Clear .ColumnCount = 6 .ColumnWidths = colWidths .Font.Size = 10 End With currentRow = 0 For i = 2 To lastRow If ws.Cells(i, 5).Value = searchValue1 And _ ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" Then ListBox2.AddItem ListBox2.List(currentRow, 0) = ws.Cells(i, 1).Value ' كود ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value ' صنف ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value ' سعر ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value ' كمية المخزون ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value ' اسم المخزن ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value ' تاريخ نهاية الصنف currentRow = currentRow + 1 End If Next i عملية بحث بشرطين او اكثر.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا Option Explicit Private Sub TextBox1_Change() Dim WS As Worksheet: Set WS = ActiveSheet Dim LastRow As Long, OnRng As Range LastRow = WS.Cells(WS.Rows.Count, 3).End(xlUp).Row Set OnRng = WS.Range("A2:AE" & LastRow) If Me.TextBox1.Value = "" Then If WS.AutoFilterMode Then WS.AutoFilterMode = False End If Else OnRng.AutoFilter Field:=3, _ Criteria1:=Me.TextBox1.Value & "*", Operator:=xlOr, Criteria2:=Me.TextBox1.Value End If End Sub

وعليكم السلام ورحمة الله تعالى وبركاته اظافة للكود المقترح من طرف الأستاد @عبدالله بشير عبدالله جزاه الله خيرا الحل بالمعادلات الخلية (O5) لجلب الأسماء بناء على وجود غياب (A) =IFERROR(INDEX($B$5:$B$8, SMALL(IF($D$5:$H$8="A", ROW($B$5:$B$8)-ROW($B$5)+1), ROW(A1))), "") الخلية (P5) لجلب تواريخ الغياب =IFERROR(INDEX($D$4:$H$4, SMALL(IF(INDEX($D$6:$H$8, MATCH(O5, $B$6:$B$8, 0), 0)="A", COLUMN($D$4:$H$4)-COLUMN($D$4)+1), COUNTIF($O$5:O5, O5))), "") مثال .xlsx

هل هذا طلبك ......

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

تفضل جرب هدا Private Sub CommandButton1_Click() Dim ws As Worksheet, src As Range, i As Long Dim arr() As Variant, columns() As Variant Dim Code As String, lastrow As Long, exists As Long Set ws = Sheets("التكويد") lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row Code = Me.TextBox4.Value If Code = "" Then: MsgBox "الرجاء إدخال كود الصنف", vbExclamation, "خطأ": Exit Sub exists = WorksheetFunction.CountIf(ws.Range("a2:a" & lastrow), Code) If exists > 0 Then: MsgBox "كود الصنف موجود مسبقا", vbExclamation, "إنتبـــاه": Me.TextBox4.Value = "": Exit Sub With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Set src = ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0) columns = Array("A", "B", "C", "D", "F", "G", "H") arr = Array(Me.TextBox4.Value, Me.TextBox1.Value, Me.TextBox7.Value, Me.TextBox2.Value, _ Me.TextBox3.Value, Me.TextBox5.Value, Me.TextBox6.Value) For i = LBound(arr) To UBound(arr) If i <= UBound(columns) Then ws.Cells(src.Row, columns(i)).Value = arr(i) End If Next i For Each ctrl In Me.Controls If TypeName(ctrl) = "TextBox" Then ctrl.Value = "" End If Next ctrl With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With MsgBox "تم إدخال البيانات بنجاح", vbInformation, "نجاح" End Sub عدم تكرار .xlsm

بعض مما عندكم 🌹 نعم في محلة لذا كان الاخ شايب عند الاضطرار يعمل التعديل عند فتح القاعدة ثم يعيد القيمة الافتراضية عند اغلاقها طبعا التعديل والاعادة اما بملف دفعي او من خلال الكود وفي الحالتين بدون تدخل المستخدم لاشك في ذلك استاذنا 🌹

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

السلام عليكم ورحمة الله وبركاته صباح الخير الاستاذ سعيد بما اننا في نفس العمر تقريبا 61 سنة واشتراكنا بالمنتدى تقريبا فى نفس السنة بفارق عام اهديك هذا الملف مع تحياتنا الخالصة لاخينا الاستاذ محمد هشام وادعو الله ان يمدكما بطول العمر ويمتعكما بالصحة وراحة البال والرزق الوفير بمكن كتابة تاريخ البدابة والتهاية يدوبا في L2 -N2 فتتم العملية الزر في الصفحة اخنياري ولبس اساسى مهمته انك تكتب تاربخ البداية بدويا ثم تكتب عدد الايام المراد اظافتها الى التاريخ في N3 ثم اضغط على الزر فبظفها الى تاريخ النهاية تحياتى لكما ولكل اخوتنا في هذا المنتدى انقسام الشهور على قائمتبن.xlsm

العفو اخي @سعيد بيرم هدا الملف يتضمن نفس الفكرة مع استخراج الايام بداية من يوم الاحد على عمود A:B ادراج أيام الشهر كاملا all .xlsm

تفضل SavedPath = """" & CurrentProject.Path & "\Public_Library\" & Me.Book_Name & "\r.pdf" & """" SavedPath = CurrentProject.Path & "\Public_Library\" & Me.Book_Name & "\r.pdf"

هدا بسبب عدم توافق نسخة الاوفيس لديك مع المعادلات المستخدمة على العموم لإثراء الموضوع أكثر اليك دالة تنفد المطلوب بادن الله عند التغيير في الخلية C2 Function xdates(StartDate As Variant) As Variant Dim Dates() As Variant Dim Days() As String Dim Result() As Variant Dim tmp As Date, r As Date Dim n As Long, i As Long, maxday As Long If IsEmpty(StartDate) Or Not IsDate(StartDate) Then xdates = Array("") Exit Function End If maxday = 30 ' الحد الأقصى لعدد الأيام r = DateSerial(Year(StartDate), Month(StartDate) + 1, 0) ' العثور على أول يوم أحد tmp = StartDate + (7 - Weekday(StartDate, vbSunday)) Mod 7 If Weekday(StartDate, vbSunday) = 1 Then tmp = StartDate End If ReDim Dates(1 To maxday) ReDim Days(1 To maxday) For tmp = tmp To r ' تجاهل يومي الجمعة (6) والسبت (7) If Weekday(tmp, vbSunday) <= 5 Then ' أيام الأحد إلى الخميس فقط n = n + 1 Days(n) = Choose(Weekday(tmp, _ vbSunday), "الأحد", "الاثنين", "الثلاثاء", "الأربعاء", "الخميس") Dates(n) = tmp If n >= maxday Then Exit For End If Next tmp ReDim Result(1 To n, 1 To 2) For i = 1 To n Result(i, 1) = Days(i) Result(i, 2) = Dates(i) Next i xdates = Result End Function في الخلية A6 =xdates(C2) في حالة الرغبة بإستخراج النتائج قيم يمكنك وضع الكود التالي في حدث ورقة Sheet1 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim f As Worksheet: Set f = ThisWorkbook.Sheets("Sheet1") Dim rCrit As Variant, startRow As Long, startCol As Long On Error GoTo CleanExit startRow = 5 'رقم الصف startCol = 1 '(A)' أول عمود لوضع النتائج If Not Intersect(Target, Me.Range("C2")) Is Nothing Then rCrit = xdates(Me.Range("C2").Value) With f.Range("k6:l" & f.Rows.Count) .ClearContents End With If Not IsEmpty(rCrit) Then Dim i As Long For i = LBound(rCrit) To UBound(rCrit) f.Cells(startRow + i, startCol).Value = rCrit(i, 1) f.Cells(startRow + i, startCol + 1).Value = rCrit(i, 2) Next i End If End If CleanExit: End Sub قم تطبيق الفكرتين على نفس الملف لتختار ما يناسبك أيام الشهر من يوم محدد vba.xlsb

ادخل الرمز المطلوب ثم اضغط على مفتاح انتر .... 111 (KAN).accdb

ما شاء الله تبارك الله مهندسنا مستر @Foksh 😄👏 نقلة نوعية ماشاء الله .. إشي فنتاستك 🤩👌 هذي فعلا بدها منسف يا زلمة 😋🍲 الجرافكس مع التصميم والبرمجة عامل مزيج إبداعي متميز .. تستاهل خمس نجوم ⭐⭐⭐⭐⭐.. الله يوفقك ويبارك فيك 😊🤲

في التحديث الجديد ، تم اعتماد نفس نمط المتاهة ولكن مع تغيير وتحديث المستوى من 1 - 30 ، حيث سيكون في كل مستوى متقدم لغز جديد يختلف عن السابق وبتصاعد وتيرة التحدي من السهل الى الصعب في آخر مستوى ( المستوى 30 ) . جميع التعديلات في نمط المتاهة من تعديلي وتصميمي وهذا شكل التصميم الذي تم اعتماده تقريباً ؛ ما لم يطرأ أي تحديث للأفضل .

الحمد لله اعانك الله ووفقك

مرفق ملف للإصدارات الـ 32 Haze Game (32 Bit).zip

معك حق في هذه النقطة ( لكن حالياً انا عندي النظام 64 ، ولكن ثق تماماً أني سأرفق لك ولأصحاب الإصدارات الـ 32 بت نسخة مخصصة ) ، والهدف هو ليس التقييم باإعداب وإنما للملاحظات والتطويرات ليس أكثر . أشكرك على الكلام اللطيف صديقي المهندس عمر .. تمام الحمد لله ، مع العلم ان هذه النسخة فقط بدائية وقيد التطوير بنظام أجمل ومراحل تصل إلى 30 مرحلة ..

بسيطة 😉 سوف أحاول تعديل الأكواد السابقة على هذا الملف بطريقة مختلفة لتتمكن من عرض البيانات بالشكل المطلوب مع بعض التحسينات تفضل اخي @عادل ابوزيد Option Explicit Private Const Mysh_Name As String = "البداية" Private Const MyFind_Column As Integer = 5 Private Const iHeight As Integer = 20 Private iGblInhibitTextBoxEvents As Boolean Private Sub UserForm_Initialize() kh_Add_Labels Me.Frame2, 5 Me.Frame2.BorderStyle = 0 End Sub Private Sub kh_Add_Controls(MyCont As Control, MyTop As Double, MyHeight As Double, iRo As Long, rowData() As String) Dim MyTxt As Control Dim i As Integer Dim tmp As Double Dim Colarr(1 To 12) As Double Dim columnHeights(1 To 12) As Double Dim defaultWidths As Variant defaultWidths = Array(68, 80, 80, 130, 170, 110, 80, 90, 80, 80, 80, 115) For i = 1 To 12 Colarr(i) = defaultWidths(i - 1) columnHeights(i) = 25 Next i tmp = 0 For i = UBound(rowData) To 1 Step -1 Set MyTxt = MyCont.Add("Forms.TextBox.1", Cells(iRo, 3 + i - 1).Address, True) With MyTxt .Move tmp, MyTop, Colarr(i), columnHeights(i) .Text = rowData(i) .TextAlign = fmTextAlignRight .Font.Size = 13 .Font.Name = "Times New Roman" .BorderStyle = fmBorderStyleSingle .BorderColor = RGB(128, 128, 128) End With tmp = tmp + Colarr(i) + 0.15 Next i Set MyTxt = Nothing End Sub Private Sub kh_Add_Labels(MyCont As Control, MyTop As Double) Dim i As Integer Dim MyLabel As Control Dim tmp As Double Dim Colarr(1 To 12) As Double Dim defaultWidths As Variant defaultWidths = Array(72, 80, 80, 130, 170, 110, 80, 90, 80, 80, 80, 115) For i = 1 To 12 Colarr(i) = defaultWidths(i - 1) Next i Dim spacing As Double spacing = 0.15 tmp = 0 For i = 12 To 1 Step -1 Set MyLabel = MyCont.Add("Forms.Label.1", "Label" & i, True) With MyLabel .Caption = Worksheets("البداية").Cells(6, 3 + i - 1).Value .Move tmp, MyTop, Colarr(i), 20 .TextAlign = fmTextAlignCenter .Font.Size = 14 .Font.Name = "Times New Roman" .BorderStyle = fmBorderStyleSingle .BorderColor = RGB(192, 192, 192) .BackColor = RGB(51, 204, 204) End With tmp = tmp + Colarr(i) + spacing Next i Set MyLabel = Nothing End Sub Private Sub kh_Find(MyText As String) Dim MyHght As Double, MyTp As Double Dim Last As Long, ii As Long, i As Long Dim Found As Boolean Found = False MyTp = 0 Application.ScreenUpdating = False With Worksheets(Mysh_Name) Last = .Cells(.Rows.Count, MyFind_Column).End(xlUp).Row For ii = 2 To Last If CStr(.Cells(ii, MyFind_Column)) Like IIf(Me.Check_Text.Value, "", "*") & MyText & "*" Then MyHght = .Rows(ii).RowHeight Dim rowData(1 To 12) As String For i = 3 To 14 If i = 4 Or i = 9 Or i = 11 Or i = 12 Or i = 13 Then If IsDate(.Cells(ii, i).Value) Then rowData(i - 2) = Format(.Cells(ii, i).Value, "yyyy/mm/dd") Else rowData(i - 2) = CStr(.Cells(ii, i).Value) End If Else rowData(i - 2) = CStr(.Cells(ii, i).Value) End If Next i If MyHght < iHeight Then MyHght = iHeight kh_Add_Controls Me.Frame1, MyTp, MyHght, .Cells(ii, MyFind_Column).Row, rowData MyTp = MyTp + MyHght + 2 Found = True End If Next End With If Not Found Then MsgBox TextBox_Find.Value & " " & "رقم الملف غير موجود", vbExclamation Me.TextBox_Find.Value = "" End If If MyTp >= Me.Frame1.Height Then Me.Frame1.ScrollHeight = MyTp Application.ScreenUpdating = True End Sub تنسيق الفورم.rar

وعليكم السلام ورحمة الله تعالى وبركاته تم تعديل الاكواد لتتناسب مع طلبك مع تغيير طريقة تعديل البيانات ليتم تنفيدها عند الظغط على زر التعديل Option Explicit Private Const Mysh_Name As String = "البداية" Private Const MyFind_Column As Integer = 5 Private Const iHeight As Integer = 20 Private Sub kh_Add_Controls(MyCont As Control, MyTop As Double, MyHeight As Double, iRo As Long, rowData() As String) Dim MyTxt As Control Dim i As Integer For i = 1 To UBound(rowData) Set MyTxt = MyCont.Add("Forms.TextBox.1", Cells(iRo, i + 2).Address, True) With MyTxt .Move MyCont.Controls(i - 1).Left, MyTop, MyCont.Controls(i - 1).Width, MyHeight .MultiLine = True .Text = rowData(i) End With With Worksheets(Mysh_Name).Cells(iRo, i + 2) MyTxt.TextAlign = Me.kh_TextAlign(.HorizontalAlignment) MyTxt.Font.Bold = .Font.Bold MyTxt.Font.Size = .Font.Size MyTxt.FontName = .Font.Name End With Next i Set MyTxt = Nothing End Sub Private Sub kh_Find(MyText As String) ' البحث Dim MyHght As Double, MyTp As Double Dim Last As Long, ii As Long Dim Found As Boolean Found = False With Me.Frame1 MyTp = .Controls(0).Top + .Controls(0).Height + 2 End With Application.ScreenUpdating = False With Worksheets(Mysh_Name) Last = .Cells(.Rows.Count, MyFind_Column).End(xlUp).Row For ii = 2 To Last If CStr(.Cells(ii, MyFind_Column)) Like IIf(Me.Check_Text.Value, "", "*") & MyText & "*" Then MyHght = .Rows(ii).RowHeight Dim rowData(1 To 12) As String 'الأعمدة من C إلى N Dim i As Integer For i = 3 To 14 If i = 4 Or i = 9 Or i = 11 Or i = 12 Or i = 13 Then ' D, I, K, L, M If IsDate(.Cells(ii, i).Value) Then rowData(i - 2) = Format(.Cells(ii, i).Value, "yyyy/mm/dd") Else rowData(i - 2) = CStr(.Cells(ii, i).Value) End If Else rowData(i - 2) = CStr(.Cells(ii, i).Value) End If Next i If MyHght < iHeight Then MyHght = iHeight kh_Add_Controls Me.Frame1, MyTp, MyHght, .Cells(ii, MyFind_Column).Row, rowData MyTp = MyTp + MyHght + 2 Found = True End If Next End With If Not Found Then MsgBox TextBox_Find.Value & " " & "رقم الملف غير موجود", vbExclamation Me.TextBox_Find.Value = "" End If If MyTp >= Me.Frame1.Height Then Me.Frame1.ScrollHeight = MyTp Application.ScreenUpdating = True End Sub Private Function FormatDate(dateValue As Variant) As String If IsDate(dateValue) Then FormatDate = Format(dateValue, "yyyy/mm/dd") Else FormatDate = "" End If End Function Private Sub Button_Save_Click() ' تعديل البيانات If Me.TextBox_Find.Value = "" Then Exit Sub Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Dim MyCon As Control Dim cellAddress As String Dim cellValue As String On Error Resume Next For Each MyCon In Me.Frame1.Controls If TypeName(MyCon) = "TextBox" Then cellAddress = MyCon.Name cellValue = MyCon.Text Worksheets(Mysh_Name).Range(cellAddress).Value = cellValue End If Next MyCon On Error GoTo 0 Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic MsgBox "تم حفظ التعديلات بنجاح", vbInformation End Sub Private Sub kh_Remove() On Error Resume Next Dim MyCon As Control Me.Frame1.ScrollHeight = 0 For Each MyCon In Me.Frame1.Controls If TypeName(MyCon) = "TextBox" Then Me.Frame1.Controls.Remove MyCon.Name End If Next MyCon On Error GoTo 0 End Sub Private Sub Button_Find_Click() If Me.TextBox_Find.Value = "" Then MsgBox "يرجى إظافة رقم الملف", vbInformation: Exit Sub kh_Remove If Len(Trim(Me.TextBox_Find.Text)) Then kh_Find Me.TextBox_Find End If End Sub Private Sub TextBox_Find_Change() kh_Remove End Sub Function kh_TextAlign(MyAlign) As Integer Dim Ag Dim A As Integer For A = 1 To 3 Ag = Choose(A, -1131, -1108, -1152) If Ag = MyAlign Then kh_TextAlign = A: Exit Function Next kh_TextAlign = 1 End Function تنسيق الفورم.rar

شرح الكود من العم أبو ذكاء 😁🖐: هذا الكود هو جزء من تطبيق يستخدم لغة VBA (Visual Basic for Applications) لإنشاء شريحة جديدة في برنامج PowerPoint والتقاط صورة منها. إليك شرحًا لوظيفة كل جزء من الكود: ### وظيفة الكود: 1. **إعداد المتغيرات**: - يتم تعريف مجموعة من المتغيرات (مثل `PptApp`, `PptDoc`, `Diapo`, `Sh`, `Sh1`) للتعامل مع كائنات PowerPoint. 2. **إنشاء تطبيق PowerPoint جديد**: - يتم إنشاء مثيل جديد من PowerPoint وفتح عرض تقديمي جديد. 3. **إضافة شريحة جديدة**: - يتم إضافة شريحة جديدة إلى العرض التقديمي وتعيين تخطيطها إلى فارغ (`ppLayoutBlank`). 4. **إضافة شكل مستطيل**: - يتم إضافة شكل مستطيل إلى الشريحة ليكون خلفية بيضاء. 5. **إضافة نص**: - يتم إضافة تسميات نصية إلى الشريحة، مع تحديد النص ولون الخط وحجمه. النص يتم الحصول عليه من خاصية `Me.note`، وإذا كان فارغًا يتم استخدام القيمة الافتراضية "kanory". 6. **توسيع الشكل ليناسب النص**: - يتم ضبط حجم الشكل تلقائيًا ليناسب النص المضاف. 7. **توسيع الشكل في وسط الشريحة**: - يتم تحديد موقع الشكل ليكون في وسط الشريحة. 8. **حفظ الشريحة كصورة**: - يتم حفظ الشريحة كصورة بتنسيق JPG في مجلد معين. 9. **إغلاق PowerPoint**: - بعد حفظ الصورة، يتم إغلاق العرض التقديمي وتطبيق PowerPoint. 10. **نسخ الصورة**: - يتم التحقق مما إذا كانت الصورة قد تم حفظها بنجاح. إذا كان هناك ملف صورة، يتم نسخه إلى موقع آخر مع اسم محدد. بعد ذلك، يتم حذف النسخة الأصلية. ### ملخص: الكود يقوم بإنشاء شريحة في PowerPoint، يضيف إليها نصًا وشكلًا، ثم يقوم بحفظ الشريحة كصورة JPG في مجلد محدد. في النهاية، ينسخ الصورة إلى اسم جديد (إذا لزم الأمر) ويحذف النسخة الأصلية.

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

وعليكم السلام ورحمة الله تعالى وبركاته للحصول على النتائج بالترتيب المطلوب يمكنك استخدام الصيغة التالية للحصول على الأسماء التي تتضمن القيمة ب USD في الخلية A3 =UNIQUE(FILTER(Sheet1!A2:A45, Sheet1!G2:G45<>"")) وفي الخلية C3 =IF(A3<>"", SUMIFS(Sheet1!$G$2:$G$45, Sheet1!$A$2:$A$45, A3), "") مع سحبها لغاية اخر صف به بيانات من الأسماء المستخرجة وبعد اخر صف به بيانات على العمود A ضع المعادلة التالية لجلب الأسماء التي تتضمن EGP =UNIQUE(FILTER(Sheet1!A2:A45, Sheet1!F2:F45<>"")) وبنفس الطريقة في اخر خلية بها بيانات من عمود C =IF(A16<>"", SUMIFS(Sheet1!$F$2:$F$45, Sheet1!$A$2:$A$45, A16), "") Suppliers.xlsx أنصحك أخي @هانى محمد باستخدام الأكواد لتتمكن من الحصول على النتائج المطلوبة بطريقة ديناميكية دون تقييد لخلايا وضع المعادلات خاصة ادا كانت البيانات غير ثابتة وقابلة للزيادة مما سوف يساعدك على الإشتغال على الملف بشكل مرن ومطاطي وحصولك على النتائج بالترتيب المطلوب جرب هدا Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim LastRow As Long, n As Long, a As Collection, b As Collection Dim TotalG As Double, TotalF As Double, Kay As Variant, rng As Range Dim ColG As Variant, ColF As Variant, i As Long Dim Irow As Long, j As Variant, totals As Variant Dim WS As Worksheet: Set WS = Sheets("Sheet1") Dim dest As Worksheet: Set dest = Sheets("Total") If Not Intersect(Target, WS.Range("A2:G" & WS.Rows.Count)) Is Nothing Then Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False On Error Resume Next Dim tbl As ListObject Set tbl = dest.ListObjects(1) If Not tbl Is Nothing Then tbl.Unlist End If On Error GoTo 0 LastRow = dest.Cells(dest.Rows.Count, "A").End(xlUp).Row If LastRow >= 3 Then dest.Range("A3:D" & LastRow).Clear End If If dest.Cells(2, "A").Value = "" Then dest.Range("A2:D2").Value = Array("Supplier Name", "Cheque Name", "Amount", "Curr") End If LastRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row ColG = Application.Transpose(WS.Range("G2:G" & LastRow).Value) ColF = Application.Transpose(WS.Range("F2:F" & LastRow).Value) Set a = New Collection: Set b = New Collection On Error Resume Next For i = 2 To LastRow If ColG(i - 1) <> "" Then a.Add WS.Cells(i, "A").Value, CStr(WS.Cells(i, "A").Value) If ColF(i - 1) <> "" Then b.Add WS.Cells(i, "A").Value, CStr(WS.Cells(i, "A").Value) Next i On Error GoTo 0 n = 3 For Each Kay In a dest.Cells(n, "A").Value = Kay dest.Cells(n, "C").Value = Application.WorksheetFunction.SumIf _ (WS.Range("A2:A" & LastRow), Kay, WS.Range("G2:G" & LastRow)) dest.Cells(n, "D").Value = "USD" TotalG = TotalG + dest.Cells(n, "C").Value n = n + 1 Next Kay For Each Kay In b dest.Cells(n, "A").Value = Kay dest.Cells(n, "C").Value = Application.WorksheetFunction.SumIf _ (WS.Range("A2:A" & LastRow), Kay, WS.Range("F2:F" & LastRow)) dest.Cells(n, "D").Value = "EGP" TotalF = TotalF + dest.Cells(n, "C").Value n = n + 1 Next Kay totals = Array("Total USD", TotalG, "Total EGP", TotalF) n = n + 1 j = Array("USD", "EGP") For i = LBound(totals) To UBound(totals) Step 2 dest.Cells(n + (i / 2), "A").Value = totals(i) dest.Cells(n + (i / 2), "C").Value = totals(i + 1) dest.Cells(n + (i / 2), "D").Value = j(i / 2) Next i For i = 3 To n - 1 dest.Cells(i, "C").NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)" Next i Irow = n + (UBound(totals) \ 2) Set tbl = dest.ListObjects.Add(xlSrcRange, dest.Range("A2:D" & Irow), , xlYes) tbl.Name = "ResultsTable" tbl.TableStyle = "TableStyleLight19" For i = Irow - 2 To Irow - 1 With tbl.Range.Rows(i).Borders .LineStyle = xlContinuous .Color = RGB(0, 0, 0) .Weight = xlMedium End With Next i Set rng = dest.Range("D3:D" & n - 1) With rng.FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""EGP""") .Interior.Color = RGB(255, 192, 203) .Font.Color = RGB(255, 0, 0) End With With tbl.Range.Columns("B:D") .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End If End Sub Suppliers VBA .xlsb

هو كذا دوما في غالب طلباته مقصر في الشرح والايضاح .. من شرحه الاخير اعتقد فهمت له ------------------------------------------------ استاذ عبدالقدوس لا يصلح تربط بين المفاتيح في الجدولين كعلاقة تم تحقيق طلبك انظر المرفق الحقل الذي اعتقد لا يمكن تكراره بين الاشخاص هو الرقم الخاص لذا اعتمدته في البحث والعد Dim i1, i2 As Integer Me.Form.Filter = "numt Like '" & textsearch & "'" Me.Form.FilterOn = True i1 = Nz(DCount("*", "tabl1", "numt = '" & textsearch & "'"), 0) i2 = Nz(DCount("*", "tabl2", "numt = '" & textsearch & "'"), 0) t1 = i1 t2 = i2 tt = i1 + i2 مثال2.rar

وعليكم السلام ورحمة الله تعالى وبركاته جرب هل هدا ما تقصده Option Explicit Sub FindMaxClass() Dim tmp As Double Dim i&, kay&, n&, lastRow Dim WS As Worksheet: Set WS = Sheets("Sheet1") lastRow = WS.Cells(WS.Rows.Count, 2).End(xlUp).Row tmp = Application.WorksheetFunction.Max(WS.Range("B2:B" & lastRow)) n = 0 For i = 2 To lastRow If WS.Cells(i, 2).value = tmp Then If WS.Cells(i, 1).value > n Then n = WS.Cells(i, 1).value End If End If Next i kay = n WS.Range("E1").Resize(1, 2).value = Array(kay, tmp) End Sub لتنفيد الكود مباشرة عند التغيير في أحد الأعمدة Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim WS As Worksheet Set WS = Me If Not Intersect(Target, WS.Range("A:B")) Is Nothing Then If Target.Row > 1 Then Dim i As Long, kay As Long, lastRow As Long Dim a As Variant, tmp As Double lastRow = WS.Cells(WS.Rows.Count, 2).End(xlUp).Row a = WS.Range("A2:B" & lastRow).value tmp = Application.WorksheetFunction.Max(Application.Index(a, 0, 2)) kay = 0 For i = LBound(a, 1) To UBound(a, 1) If a(i, 2) = tmp Then If a(i, 1) > kay Then kay = a(i, 1) End If End If Next i WS.Range("E1").Resize(1, 2).value = Array(kay, tmp) End If End If End Sub test1.xlsb

اتفضل طلبك لكن انصحك نصيحه لوجه الله لا تجعل اسماء الحقول فى الجداول بالعربي هتتعبك قدام test(1).rar

السلام عليكم: لدي في الملف المرفق نموذج يحتوي على مربع نص باسم (نوع السيارة). المطلوب : انشاء كود في مربع النص يحتوي على اربع انواع من السيارات فقط (تويوتا . جيب . نيسان . هونداي) وعند كتابة اي نوع اخر من السيارات تظهر رسالة خطأ في الكتابة او اي نص نختاره في الرسالة ويتوقف ولا ينتقل الى المربع التالي. (( لا نريد التطبيق على القائمة المنسدلة )) مع فائق الشكر والاحترام.. New.accdb

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

بل حسب اجتهادك .. وليس بالضرورة ان يكون الاجتهاد صوابا الاستعلام يقوم بمثل هذه المهام .. ويمكنك جعله مصدرا

انا فتحت النموذج وشايف انك بالفعل عامل ده وجايب ليك العدد وجايب ليك البيانات وفى شريط السجلات تحت مكتوب انها 2 سجل موجود ممكن تستعرضهم فوالله ثم والله ما فهمت عليك انا حاسس ان طلبك بسيط جدا بس انا مش عارف ازاى افهم انت عاوز ايه بالظبط 😅

موضوعك غير مهيأ 1- في التقارير تريد اظهارها حسب الدرجة ، والدرجة في الجدول مدمجة ، بينما في الفورم يتم الاختيار مفرد 2- المفترض طلبك يكون حول نقطة واحدة فقط ، حتى لا يتشتت فكر من يتصدى للإجابة ملاحظة مهمة : عملك الدمج اصلا في الجدول خطأ فادح .. وانما يتم حسب الحاجة في الاستعلام او التقرير

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

ممكن تشرحلى بالتفصيل انت عاوز تعمل ايه بالظبط يعنى لما يحصل ايه يظهر ايه وبالشكل المعين كذا علشان افهمك واحاول مساعدتك

قمت بعمل برنامج بسيط 1- اضافة بيانات المرضي 2- اضافة بيانات المعالجين 3- التعديل على بيانات المستخدمين وصلاحيات (بطريقة بسيطه لتوضيح الفكره) واضافة جديد ايضا 4- اضافة حركة او قيد او زيارة كما تحب ان تسميها 5- كشف حساب للمرضي 6- كشف حساب للمعالجين 7- لتبديل المستخدم 8- لغلق البرنامج عند تشغيل القاعده هيظهر لى نموذج الدخول (معمول بشكل بسيط ايضا) 😅 تم تسجيل 2 مستخدمين الاول اسم المستخدم 1 وكلمة السر 1 (لديه جميع الصلاحيات) الثاني اسم المستخدم 2 وكلمة السر 2 (لديه بعض الصلاحيات) نزل البرنامج وحاول اولا تشوف فكرته واذا واجهتك اى صعوبة فى فهم الية العمل اسأل هنا وهشرحلك كل شئ Clinic_001.rar

@عمر ضاحى ممنون استاذ لاتعرف كم افادني هذا الامر جزاك الله كل خير

ليس هناك مستحيل اخي @عبد الرحمن أشرف يمكننا إظافة دالة جديدة مع الحفاظ على الأولى لتتمكن من إختيار ما يناسبك الدالة الجديدة مع التفقيط Option Explicit Function CalcAgeArabic(vDate1 As Variant, vDate2 As Variant, ByVal resultType As String) As Variant Dim vYears As Integer, vMonths As Integer, vDays As Integer If IsEmpty(vDate1) Or IsEmpty(vDate2) Then CalcAgeArabic = "" Exit Function End If If Not IsDate(vDate1) Or Not IsDate(vDate2) Then CalcAgeArabic = CVErr(xlErrValue) Exit Function End If If vDate2 < vDate1 Then MsgBox "التاريخ الثاني يجب أن يكون أكبر من الأول" CalcAgeArabic = CVErr(xlErrValue) Exit Function End If vYears = Year(vDate2) - Year(vDate1) vMonths = Month(vDate2) - Month(vDate1) vDays = Day(vDate2) - Day(vDate1) If vDays < 0 Then vMonths = vMonths - 1 Dim lastMonth As Date lastMonth = DateAdd("m", -1, vDate2) vDays = Day(DateSerial(Year(lastMonth), Month(lastMonth) + 1, 1) - 1) + vDays End If If vMonths < 0 Then vYears = vYears - 1 vMonths = vMonths + 12 End If Select Case resultType Case "Days" CalcAgeArabic = NumberToArabicWords(vDays) & " يوم" Case "Months" CalcAgeArabic = NumberToArabicWords(vMonths) & " شهور" Case "Years" CalcAgeArabic = NumberToArabicWords(vYears) & " سنوات" Case "Days and Months" CalcAgeArabic = NumberToArabicWords(vMonths) & " شهور و " & NumberToArabicWords(vDays) & " يوم" Case "Years and Months" CalcAgeArabic = NumberToArabicWords(vYears) & " سنوات و " & NumberToArabicWords(vMonths) & " شهور" Case "Years, Months, Days" CalcAgeArabic = NumberToArabicWords(vYears) & " سنوات و " & NumberToArabicWords(vMonths) & " شهور و " & _ NumberToArabicWords(vDays) & " يوم" Case Else CalcAgeArabic = "صيغة الدالة غير معروفة" End Select End Function Function NumberToArabicWords(ByVal Number As Integer) As String Select Case Number Case 1: NumberToArabicWords = "واحد" Case 2: NumberToArabicWords = "اثنان" Case 3: NumberToArabicWords = "ثلاثة" Case 4: NumberToArabicWords = "أربعة" Case 5: NumberToArabicWords = "خمسة" Case 6: NumberToArabicWords = "ستة" Case 7: NumberToArabicWords = "سبعة" Case 8: NumberToArabicWords = "ثمانية" Case 9: NumberToArabicWords = "تسعة" Case 10: NumberToArabicWords = "عشرة" Case 11: NumberToArabicWords = "أحد عشر" Case 12: NumberToArabicWords = "اثنا عشر" Case 13: NumberToArabicWords = "ثلاثة عشر" Case 14: NumberToArabicWords = "أربعة عشر" Case 15: NumberToArabicWords = "خمسة عشر" Case 16: NumberToArabicWords = "ستة عشر" Case 17: NumberToArabicWords = "سبعة عشر" Case 18: NumberToArabicWords = "ثمانية عشر" Case 19: NumberToArabicWords = "تسعة عشر" Case 20: NumberToArabicWords = "عشرون" Case 21: NumberToArabicWords = "واحد وعشرون" Case 22: NumberToArabicWords = "اثنان وعشرون" Case 23: NumberToArabicWords = "ثلاثة وعشرون" Case 24: NumberToArabicWords = "أربعة وعشرون" Case 25: NumberToArabicWords = "خمسة وعشرون" Case 26: NumberToArabicWords = "ستة وعشرون" Case 27: NumberToArabicWords = "سبعة وعشرون" Case 28: NumberToArabicWords = "ثمانية وعشرون" Case 29: NumberToArabicWords = "تسعة وعشرون" Case 30: NumberToArabicWords = "ثلاثون" Case Else: NumberToArabicWords = CStr(Number) End Select End Function حساب الفرق بين تاريخين - بالتفقيط (1).xlsm

نعم أخى محمد هذا ما أقصده هناك نقطة أخيرة فى هذا الموضوع إن لم أكن مزعجاً ***** ولسنا فى عجلة من أمرنا لأنه ربما تستغرق هذة النقطة الكثير من وقتكم الثمين لتعديلها تتمثل هذة النقطة فى كيف يمكن تغيير اللغة الإنجليزية إلى اللغة العربية كما نقول باللغة العربية على سبيل المثال ومن اليمين إلى اليسار 5 سنوات و 3 شهور و 18 يوم أو ربما يوجد كود لتفقيط عدد السنوات والشهور والأيام كقولنا **** خمسة سنوات وثلاثة أشهر وثمانية عشر يوما أم تعدو هذه النقطة حُلما لى **** أرجو الإفادة وإن لم يكن أخى وحبيبى فى الله محمد فقد وفيت وكفيت وعشت وعاش المغرب الحبيب وعاشت مصر الحبيبة

من خلال الجملة الشرطية تستطيع تنفيذها يا صديقي 🤗

Private Sub Form_BeforeUpdate(Cancel As Integer) Dim t54Value As Integer Dim devValue As String Dim response As Integer t54Value = Me.t54 devValue = Me.dev ' تحقق إذا كانت قيمة t54 تساوي 6 وأيضاً إذا dev لا يحتوي على الرقم 5 If t54Value = 6 And Not devValue Like "*5" Then ' إظهار رسالة تأكيد response = MsgBox("الحقل dev يجب أن يحتوي على الرقم 5. هل ترغب في الاستمرار؟", vbYesNo + vbExclamation, "تأكيد") If response = vbNo Then ' إذا اختار المستخدم "لا"، أعد الحقل t54 إلى Null أو القيمة الافتراضية Me.t54 = Null ' أو يمكنك تعيين قيمة معينة بدلًا من Null Cancel = True ' يمنع إغلاق النموذج End If End If ' تحقق إذا كان المستخدم يحاول الخروج بدون كتابة رقم الطلب الذي يبدأ برقم 5 If devValue = "" Or Left(devValue, 1) <> "5" Then ' تعيين القيم المطلوبة Me.t54 = 1 Me.dev = "لم يتم كتابة رقم الطلب أثناء التنفيذ" ' إظهار رسالة تنبيه MsgBox "تم الغاء التحديث لم يتم كتابة رقم الطلب", vbInformation, "تنبيه" Cancel = True ' يمنع إغلاق النموذج End If End Sub شرح للمتغير عن الكود السابق. تم إنشاء شرط إضافي للتحقق إذا كان الحقل dev فارغًا أو لا يبدأ برقم 5. إذا تحقق الشرط، نقوم بتعيين t54 إلى 1 و dev إلى "لم يتم كتابة رقم الطلب أثناء التنفيذ". تظهر رسالة تنبيه تخبر المستخدم بأنه تم إلغاء التحديث. يتم تعيين Cancel إلى True لمنع إغلاق النموذج إذا كانت الشروط مستوفاة. بهذا الشكل، ستحقق ما تريده. اتمني التجربة و الرد صديقي

ما شاء الله استاذ محمد معادلة وكود . اثراء للموضوع المعادلة التالية تؤدى الى نفس النتيجة وهى تستخدم دالة AGGREGATE لتحديد آخر عمود يحتوي على قيمة غير فارغة، ومن ثم دالة INDEX لاسترجاع القيمة المطابقة. المعاداة =IFERROR( IF(A14=""; ""; INDEX($B$2:$E$9; MATCH(A14; $A$2:$A$9; 0); AGGREGATE(14; 6; COLUMN($B$2:$E$2) / (INDEX($B$2:$E$9; MATCH(A14; $A$2:$A$9; 0); 0)<>""); 1) - COLUMN($B$2) + 1) ); "بدون نتيجة") الملف اخر ادخال بالصف.xlsx

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا =IFERROR(IF(A14="","",LOOKUP(2,1/(INDEX($B$2:$E$9,MATCH(A14,$A$2:$A$9,0),0)<>""),INDEX($B$2:$E$9,MATCH(A14,$A$2:$A$9,0),0))),"بدون نتيجة") أو بإستخدام vba Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim Code As Variant, dataA As Variant, dataB As Variant Dim rngA As Range, rngB As Range, rngC As Range Dim tmp As Variant, result As String Dim cell As Range, col As Long Dim msg As String: msg = "بدون نتيجة" Set rngA = Me.Range("A2:A9") Set rngB = Me.Range("B2:E9") Set rngC = Me.Range("A14:A21") Application.ScreenUpdating = False Application.EnableEvents = False On Error GoTo CleanExit If Not Intersect(Target, Union(rngB, rngC)) Is Nothing Then dataA = rngA.Value dataB = rngB.Value For Each cell In rngC If Trim(cell.Value) <> "" Then tmp = Application.Match(cell.Value, rngA, 0) If Not IsError(tmp) Then result = msg For col = 4 To 1 Step -1 If Trim(dataB(tmp, col)) <> "" Then result = dataB(tmp, col) Exit For End If Next col cell.Offset(0, 1).Value = result Else Code = cell.Value cell.Resize(1, 2).ClearContents MsgBox "الكود " & Code & " غير موجود", vbExclamation End If Else cell.Offset(0, 1).ClearContents End If Next cell End If CleanExit: Application.EnableEvents = True Application.ScreenUpdating = True End Sub ppp.xlsb

السلام عليكم اذاكانت الملفات المرتبطة عددها بسيط استخدم الطريقة اليدوية التالية فتح الملف الرئيسي: افتح ملف Excel الرئيسي الذي يحتوي على الروابط إلى الملفات الأخرى. تحرير الروابط: اذهب إلى علامة التبويب "البيانات" (Data) في الشريط. اضغط على "تحرير الروابط" (Edit Links) التي توجد عادة في مجموعة "الاتصالات" (Connections). تغيير مصدر الروابط: ستظهر لك نافذة تحتوي على جميع الروابط الموجودة في الملف. حدد الروابط التي تحتاج إلى تحديث، ثم اضغط على "تغيير المصدر" (Change Source). اختيار الموقع الجديد: اختر الملفات من الموقع الجديد الذي تم نقلها إليه. تحديث الروابط: بعد اختيار الملفات، اضغط على "موافق" لتحديث الروابط إلى الموقع الجديد. اذ كانت الروابط كثيرة فاستخدم الكود التالى Sub UpdateLinks() Dim OldLink As String Dim NewLink As String Dim LinkArray As Variant Dim i As Integer ' الرابط القديم OldLink = "C:\المسار_القديم\" ' الرابط الجديد NewLink = "C:\المسار_الجديد\" LinkArray = ActiveWorkbook.LinkSources(Type:=xlExcelLinks) If Not IsEmpty(LinkArray) Then For i = LBound(LinkArray) To UBound(LinkArray) If InStr(LinkArray(i), OldLink) > 0 Then ActiveWorkbook.ChangeLink Name:=LinkArray(i), NewName:=Replace(LinkArray(i), OldLink, NewLink), Type:=xlExcelLinks End If Next i End If MsgBox "تم تحديث الروابط بنجاح!", vbInformation End Sub قم بتعديل المسارات (OldLink و NewLink) حسب الموقع القديم والجديد للملفات.

أخي @صباح2024 إدا كنت قد إستوعبت طلبك سنقوم بتعديل الكود بطريقة مختلفة لنتمكن من تنفيد المطلوب بشكل دقيق لان دمج الاكواد على Private Sub Worksheet_Change(ByVal Target As Range) والإشتغال عليها مباشرة من شأنه أن يسبب لك عدة مشاكل خاصة انك ترغب بتحديث البيانات عند كل تغيير على اي خلية لنفترض أنك قمت باسـتدعاء اي اسم مثلا من الطبيعي ان البيانات السابقة مختلفة بمجرد استدعائها سيتم نسخها للاعمدة الخاصة بالاسم الدي تم اختياره مما سيسبب لك تلف وتعارض في البيانات اسف على الإطالة لاكن لابد من توضيح الفكرة ( اليك ما تم الإشتغال عليه) 1) جلب البيانات من ورقة السجل الى ورقة استدعاء بشرط الإسم 2) تحديث البيانات عند التغيير في أي خلية من الخلايا التي تم تمييزها باللون الأصفر على ورقة استدعاء على الأعمدة المناسبة في ورقة السجل مع مراعات الإسم 3) تم اظافة كود لإنشاء قائمة منسدلة ديناميكية بالأسماء الفريدة من العمود B ( ورقة السجل) بداية من الصف 2 تلقائيا في خلية الإسم (B6) ورقة استدعاء الأكواد المستخدمة : Public Property Get WS() As Worksheet Set WS = Sheets("استدعاء") End Property Public Property Get dest() As Worksheet Set dest = Sheets("السجل") End Property ' خلية الإسم Public Function Clé() As String Clé = WS.Range("B6").Value End Function 'نطاق البحث Public Function rng() As Range Set rng = dest.Range("B2:B" & dest.Cells(dest.Rows.Count, 2).End(xlUp).Row) End Function '======================== ' جلب البيانات من ورقة السجل إلى ورقة "استدعاء" Sub Fetch_data() Dim data As Variant, i As Long, tmp As Range Application.ScreenUpdating = False On Error GoTo CleanExit Set tmp = rng.Find(Clé, LookIn:=xlValues, LookAt:=xlWhole) If tmp Is Nothing Then MsgBox "لم يتم العثور على الإسم" & " : " & Clé & " في السجل", vbExclamation Exit Sub End If For i = 0 To 3 data = dest.Range(tmp.Offset(0, 1 + (i * 9)), tmp.Offset(0, 9 + (i * 9))).Value WS.Range("A" & (9 + (i * 3)) & ":I" & (9 + (i * 3))).Value = data Next i CleanExit: Application.ScreenUpdating = True End Sub '======================== ' تحديث البيانات من ورقة استدعاء الى ورقة السجل Sub Update_data() Dim tmp As Range, cnt() As Variant, OnRng As Range Dim ColArr() As Long, j As Long, i As Long Set OnRng = rng.Find(Clé, LookIn:=xlValues, LookAt:=xlWhole) If OnRng Is Nothing Then MsgBox "لم يتم العثور على الإسم" & " : " & Clé & " في السجل", vbExclamation Exit Sub End If Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim Irow As Long Irow = OnRng.Row ReDim ColArr(0 To 35) For j = 0 To 35 ColArr(j) = j + 3 Next j ReDim cnt(UBound(ColArr)) For i = 0 To UBound(cnt) cnt(i) = WS.Cells(9 + (i \ 9) * 3, 1 + (i Mod 9)).Value Next i For i = 0 To UBound(ColArr) If dest.Cells(Irow, ColArr(i)).Value <> cnt(i) Then dest.Cells(Irow, ColArr(i)).Value = cnt(i) End If Next i Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub '======================== ' إضافة قائمة منسدلة بالأسماء المتوفرة في ورقة "السجل" Sub Add_listeDéroulante() Dim lr As Long, arr() As String, r As Range, i As Long Dim cnt As New Collection, Names As Range lr = dest.Cells(dest.Rows.Count, 2).End(xlUp).Row On Error Resume Next For Each r In rng If r.Value <> "" Then cnt.Add r.Value, CStr(r.Value) End If Next r On Error GoTo 0 If cnt.Count = 0 Then Exit Sub ReDim arr(1 To cnt.Count) For i = 1 To cnt.Count arr(i) = cnt(i) Next i Set Names = WS.Range("B6") With Names.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=Join(arr, ",") .IgnoreBlank = True: .InCellDropdown = True: .ShowInput = True: .ShowError = True End With End Sub وفي حدث ورقة استدعاء Private Sub Worksheet_Activate() Add_listeDéroulante End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim Clé As Range, cntArr As Range Set Clé = WS.Range("B6") If Clé.Value = "" Then Exit Sub If Target.Address = Clé.Address Then On Error GoTo ErrorHandler Fetch_data Exit Sub End If ' عناوين الخلايا المستهدفة Set cntArr = Me.Range("A9:I9, A12:I12, A15:I15, A18:I18") If Not Intersect(Target, cntArr) Is Nothing Then On Error GoTo ErrorHandler Update_data Exit Sub End If Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description On Error GoTo 0 End Sub وأي إستفسار سنكون دائما سعداء بمساعدتك تحويل التغييرات من شيت الاستدعاء الى شيت السجل.xlsm

السلام عليكم ورحمة الله تعالى وبركاته طبعا قد يقول البعض ان الموضوع اتهرس فى ميت فيلم عربى قبل كده لكن على كل حال تم تدارك الكثير من المشاكل ومعالجتها بشكل احترافى - اخفاء اطار لاكسس بالشكل الطبيعى والتقليدى لعرض النموذج كاملا - اخفاء اطار الاكسس وعمل شفافية للنموذج لاظهار صور png او حسب خيال المسخدم - تم ضبط كواد التوسيط للنماذج والتقارير باحترافية ويعمل التوسيط مع الخاصية Pop Up فى اى وضع كانت فى حالة عدم استخدام الاخفاء - تم حل مشكلة عدم ظهور التقاربر عند الاخفاء بتكبير التقرير تلقائيا عند استخدام كود الاخفاء - امكانبة التصغير للتطبيق بجوار الساعة ( System Try ) - عند التصغير بجوار الساعة ممكن الضغط كليك يمين على الايقونة لتظهر قائمة اختيارات - تم ضبط كود تغير ايقونة الاكسس باحترافية وبشكل تلقائى من المسار المحدد او فى حالة عدم وجود الايقونة ترجع ايقونة الاكسس - تم التعامل مع الاكواد بحرفية تامة للعمل على بيئات الأنوية المختلفة سواء كانت 32 , 64 اترككم مع تجربة شيقة ملاحظة هامة : ارضاء للجميع ولاضفاء اكبر قدر ممكن من المرونة المرفق يحتوى على قاعدتان الاولى : تم تجميع كل الاكواد والدوال فى وحدة نمطية عامة واحدة وكلاس موديول واحد لسهولة الاستفادة منها ونقلهم الى اى قاعدة الثانية : فصل اكواد كل وظيفة على حدة فى مديول خاص بها تم اضافة تعديل وتحديث جديد بتاريخ 11/10/2024 رقم اصدار التعديل الاخيــر : 4.8 center and Hid and Tray Minimizer V 30.zip center and Hid and Tray Minimizer V 4.8.rar

** السلام عليكم ورحمة الله وبركاته ** سنضع هنا كل ماصمم من برامج على الأكسيل على أن يضاف كل جديد في حينه * متابعة رصيد البنوك * تصميم أبو أحمد * * برنامج الصندوق التعاوني * تصميم أبوإسراء* * تقويـــــم على الأكسيل * تصميم أبن مسقط * * متابعة أرصدة البنوك * تصميم حسام * * نظم مصروفاتك المنزل مع هذا البرنامج * تصميم حسام * * برنامج المشتريات والمبيعات والمستودع* الإصدار الأول * تصميم حسام * * برنامج متابعة أرصدة البنوك ( الإصدار الثاني ) تصميم حسام نور * برنامج القروض الأصدار الأول تصميم حسام نور **بـرنـــــامج الأبــــــراج تصميم حسام نور** * برنامج المخازن تصميم m.hindawi* ** برنامج متابعة المراجعين ويدعم خاصية البحث تصميم حسام نور** برنامج متابعة المصروفات الجديد " الإصدار الثاني " تصميم حسام نور برنامج القروض الإصدار الثاني تصميم حسام نور برنامج إدارة العقارات * تأجير * تسديد * مصروفات * تقارير تصميم حسام نور Calculate_Your_Age تصميم علي السحيب جدول مساعدة لحفظ القرأن الكريم (برنامج جاهز) تصميم الرواحي برنامج لكسر الحماية بواسطه الرواحي Management task manager تصميم الرواحي برنامج برنامج المصطلحات الطبية ومعانيها على السحيب برنامج لحساب العمر مع تشغيل صوت خالد نور غرائب وعجائب الاكسل عمر الحسينى برنامج جاهز لمؤجرين السيارات احمدزمان برنامج المعلم برنامج جاهز برنامج الزكاة برنامج جاهز * تصميم حسام * شهادة الطالب برنامج جاهز كنترول مدرسة برنامج جاهز التقويم بعد التعديل برنامج جاهز برنامج الدورى السعودى برنامج جاهز برنامج دراسة القوى المؤثرة على السلاسل الزمنية برنامج جاهز طباعة تقرير الاجازة المرضية برنامج جاهز برنامج حساب كلفة الاتصال بالانترنيت برنامج جاهز قالب Loan Amortization برنامج جاهز كشف حساب مبسط برنامج جاهز برنامج استهلاك الاصول الثابتة برنامج جاهز برنامج لمتابعة الصيانة والنظافة لمدرسة برنامج جاهز دليل هاتف مبسط برنامج جاهز برنامج الشهادات وكشوف الدرجات برنامج جاهز برنامج مستخرجات مدرسية برنامج جاهز لحساب تلكفة الساعة فى نت كافية برنامج جاهز برنامج ميزان المراجعة للحسابات برنامج جاهز برنامج حساب اقساط القروض بالفوائد المتناقصة برنامج جاهز مثال تقسيم الطلاب فى مجموعات متجانسة برنامج جاهز جلب اسعار اخر يوم تداول فى سوق الاسهم السعودية برنامج جاهز تقويم المناسبات برنامج جاهز برنامج جديد لحساب العمر برنامج جاهز برنامج حساب العمر بالاكسل برنامج جاهز برنامج كنترول المدرسة برنامج جاهز برنامج ضبط المخزون والمبيعات برنامج جاهز برنامج مدرسى برنامج جاهز حساب العمر بالهجرى والميلادى برنامج جاهز ملف تدقيق حسابات برنامج جاهز هدية برنامج كنترول التعليم الاعدادى بمصر برنامج جاهز كسر الحماية برنامج جاهز برنامج مخازن فقط برنامج جاهز طلب تقويم ثنائى هجرى ميلادى برنامج جاهز الحوافز المصرية برنامج جاهز برنامج تنظيم الحمل والدورة الشهرية برنامج جاهز المرتبات المصرية برنامج جاهز تاريخ اليوم بالميلادى و الهجرى برنامج جاهز برنامج طباعة الشهادات المدرسية الاعدادية برنامج جاهز امساكية شهر رمضان برنامج جاهز برنامج طباعة الشهادات المدرسية للمرحلة الابتدائية برنامج جاهز اليومية الامريكية برنامج جاهز تعامل بسلاسة مع الاسهم السعودية برنامج جاهز تخطيط الميزانية برنامج جاهز تقويم جديد برنامج جاهز برنامج عن حساب العمر بالميلادى والهجرى برنامج جاهز برنامج الدورى الانجليزى برنامج جاهز برنامج دوريات برنامج جاهز برنامج قروض جديد برنامج جاهز القران الكريم مشكلا على الاكسيل برنامج جاهز برنامج حساب العمر بالتقويمين الميلادى والهجرى برنامج جاهز برنامج رائع للتحويل بين التاريخين الهجرى والميلادى برنامج جاهز برنامج حسابات برنامج جاهز برنامج محول التواريخ وبرنامج الاعمار والابراج والصفات برنامج جاهز برنامج حسابات مبسط برنامج جاهز مقياس الحمى برنامج جاهز برنامج حساب لثلاث عملات برنامج جاهز اول مشاركة واقبلوا هديتى المتواضعة برنامج جاهز برنامج الشيكات برنامج جاهز اخيرا برنامج الحضور والانصراف برنامج جاهز نتيجة لــ 178 عام قادم بداية 2007 عليك تجربتها برنامج جاهز احدى الطرق لحساب نسبة معدلات الخصم او الاضافة برنامج جاهز برنامج محاسبى برنامج جاهز برنامج خبور المحاسبى الاصدار الاول برنامج جاهز ادخل الرقم و اعرف اللون برنامج جاهز فـــسر حلمك على الاكسيل برنامج جاهز برنامج خبور المحاسبى الاصدار الثانى برنامج جاهز ساعة ستوب واتش برنامج جاهز هديتى نظام لحساب وصرف الرواتب والبدلات الشهرية برنامج جاهز بورصتى القاهرة والاسكندرية خلال فترة زمنية برنامج جاهز النموذج الخاص بالدمغة النسبية برنامج جاهز هذة لعبة ذكاء مصممة على الاكسل برنامج جاهز ملف مهم للمغتربين المشاركين بالسكن برنامج جاهز كنترول للصف الاول والثانى لمدرسة صناعية مجربة 100% برنامج جاهز برنامج خبور المحاسبى الاصدار الثالث برنامج جاهز برنامج المستودع ومراقبة المخزون برنامج جاهز ميزانية لمحاسبة شركات المقاولات برنامج جاهز برنامج محاسبة شركات المقاولات برنامج جاهز برنامج خبور المحاسبى برنامج جاهز الى جميع المحاسبين والمهتمين بالتحليل المالى برنامج جاهز البرنامج المحاسبى الشهيرQUICKBOOKS برنامج جاهز الميزانية العمومية برنامج جاهز الجرد فى المنشات التجارية برنامج جاهز المرتبات والاجور برنامج جاهز فكرة برنامج للقروض برنامج جاهز برنامج حسابات برنامج جاهز برنامج كامل للقروض برنامج جاهز ملف للمرتبات يحسب ضريبة المرتبات والتامينات الاجتماعية برنامج جاهز نموذج فاتورة متكامل بفورم بامكانية الطباعة برنامج جاهز برنامج مرتبات برنامج جاهز يومية الصندوق الالكترونية برنامج جاهز برنامج رواتب بشكل جديد برنامج جاهز برنامج محاسبى على الاكسل برنامج جاهز نموذج تحليل مدفوعات مصروفات وخلافة برنامج جاهز برنامج كشـف صـرف النقـديـة بالفئات المتاحـة برنامج جاهز برنامج حسابات البنوك * الجديد كلياً برنامج جاهز برنامج توافق الابراج فى اكسل برنامج جاهز توزيع كشوف ملاحظة الامتحانات برنامج جاهز برنامج محاسبة جاهز برنامج جاهز برنامج كاس العالم 2010 بالمعادلات برنامج جاهز برنامج الشهادات المدرسية للمرحلة الاساسية العليا فى فلسطينبرنامج جاهز برنامج جاهز ترحيل سند صرف قبض فاتورة قيود طلب عاجل برنامج جاهز يخص عمليات الاستثمار برنامج جاهز_يومية عملاء و موردين و كشف حساب بين تاريخين برنامج جاهز_يومية مبيعات مع التقرير برنامج جاهز لادارة مكتبه_ترتيب و فهرسة الكتب برنامج جاهز_سركى الصادر و الوارد للمكاتبات و الارشيف برنامج جاهز2_سركى الصادر و الوارد للمكاتبات و الارشيف مع الطباعة و الشرح برنامج جاهز3_سركى متكامل للصادر و الوارد للمكاتبات و الارشيف برنامج جاهز_تحويل صورة و نسخها الى خلايا اكسيل برنامج جاهز_طباعة الشيكات بعملات مختلفه برنامج جاهز_ تذكير بمواعيد انتهاء اوراقك الرسمية برنامج جاهز_ طباعة ايصالات PAYROLL_تلقائيا برنامج جاهز_سند قبض و صرف برنامج جاهز_يومية و كشف حساب بين تاريخين مع اختيار عملة الحساب برنامج جاهز_برنامج احتساب القيمة الحالية للمبالغ و خصم قطع الشيكات بطريقتين برنامج جاهز_برنامج قيود يومية بالترحيل الى يوميات الاستاذ مع عمل كشف حساب برنامج جاهز_بالكود نتائج الطلاب مع الفرز _الناجح و الراسب برنامج جاهز_برنامج حسابات مع صفحات الاستاذ و ارصدة البنوك برنامج جاهز_ لجدولة انشاء و سداد اقساط مجدولة و القروض و العهد برنامج جاهز لادارة مصروفاتك الشخصيه برنامج جاهز لتحويل التاريخ من ميلادى الى هجرى ,والعكس برنامج جاهز_طباعة شيكات بنك_التجارى الدولى_cib_اصدار دفاتر 2018_مع امكانية اضافة بنوك اخرى برنامج جاهز لادارة المصاريف الشخصية برنامج جاهز للمخازن والعملاء والموردين هديتى برنامج جاهز_طباعة شيكات بنك_التجارى الدولى_CIB_مع امكانية اضافة بنوك اخرى * متابعة رصيد البنوك * تصميم أبو أحمد * * برنامج الصندوق التعاوني * تصميم أبوإسراء* * تقويـــــم على الأكسيل * تصميم أبن مسقط * * متابعة أرصدة البنوك * تصميم حسام * * نظم مصروفاتك المنزل مع هذا البرنامج * تصميم حسام * * برنامج المشتريات والمبيعات والمستودع* الإصدار الأول * تصميم حسام * * برنامج متابعة أرصدة البنوك ( الإصدار الثاني ) تصميم حسام نور * برنامج القروض الأصدار الأول تصميم حسام نور **بـرنـــــامج الأبــــــراج تصميم حسام نور** * برنامج المخازن تصميم m.hindawi* ** برنامج متابعة المراجعين ويدعم خاصية البحث تصميم حسام نور** برنامج متابعة المصروفات الجديد " الإصدار الثاني " تصميم حسام نور برنامج القروض الإصدار الثاني تصميم حسام نور برنامج إدارة العقارات * تأجير * تسديد * مصروفات * تقارير تصميم حسام نور Calculate_Your_Age تصميم علي السحيب جدول مساعدة لحفظ القرأن الكريم (برنامج جاهز) تصميم الرواحي برنامج لكسر الحماية بواسطه الرواحي Management task manager تصميم الرواحي برنامج برنامج المصطلحات الطبية ومعانيها على السحيب برنامج لحساب العمر مع تشغيل صوت خالد نور غرائب وعجائب الاكسل عمر الحسينى برنامج جاهز لمؤجرين السيارات احمدزمان برنامج المعلم برنامج جاهز برنامج الزكاة برنامج جاهز * تصميم حسام * شهادة الطالب برنامج جاهز كنترول مدرسة برنامج جاهز التقويم بعد التعديل برنامج جاهز برنامج الدورى السعودى برنامج جاهز برنامج دراسة القوى المؤثرة على السلاسل الزمنية برنامج جاهز طباعة تقرير الاجازة المرضية برنامج جاهز برنامج حساب كلفة الاتصال بالانترنيت برنامج جاهز قالب Loan Amortization برنامج جاهز كشف حساب مبسط برنامج جاهز برنامج استهلاك الاصول الثابتة برنامج جاهز برنامج لمتابعة الصيانة والنظافة لمدرسة برنامج جاهز دليل هاتف مبسط برنامج جاهز برنامج الشهادات وكشوف الدرجات برنامج جاهز برنامج مستخرجات مدرسية برنامج جاهز لحساب تلكفة الساعة فى نت كافية برنامج جاهز برنامج ميزان المراجعة للحسابات برنامج جاهز برنامج حساب اقساط القروض بالفوائد المتناقصة برنامج جاهز مثال تقسيم الطلاب فى مجموعات متجانسة برنامج جاهز جلب اسعار اخر يوم تداول فى سوق الاسهم السعودية برنامج جاهز تقويم المناسبات برنامج جاهز برنامج جديد لحساب العمر برنامج جاهز برنامج حساب العمر بالاكسل برنامج جاهز برنامج كنترول المدرسة برنامج جاهز برنامج ضبط المخزون والمبيعات برنامج جاهز برنامج مدرسى برنامج جاهز حساب العمر بالهجرى والميلادى برنامج جاهز ملف تدقيق حسابات برنامج جاهز هدية برنامج كنترول التعليم الاعدادى بمصر برنامج جاهز كسر الحماية برنامج جاهز برنامج مخازن فقط برنامج جاهز طلب تقويم ثنائى هجرى ميلادى برنامج جاهز الحوافز المصرية برنامج جاهز برنامج تنظيم الحمل والدورة الشهرية برنامج جاهز المرتبات المصرية برنامج جاهز تاريخ اليوم بالميلادى و الهجرى برنامج جاهز برنامج طباعة الشهادات المدرسية الاعدادية برنامج جاهز امساكية شهر رمضان برنامج جاهز برنامج طباعة الشهادات المدرسية للمرحلة الابتدائية برنامج جاهز اليومية الامريكية برنامج جاهز تعامل بسلاسة مع الاسهم السعودية برنامج جاهز تخطيط الميزانية برنامج جاهز تقويم جديد برنامج جاهز برنامج عن حساب العمر بالميلادى والهجرى برنامج جاهز برنامج الدورى الانجليزى برنامج جاهز برنامج دوريات برنامج جاهز برنامج قروض جديد برنامج جاهز القران الكريم مشكلا على الاكسيل برنامج جاهز برنامج حساب العمر بالتقويمين الميلادى والهجرى برنامج جاهز برنامج رائع للتحويل بين التاريخين الهجرى والميلادى برنامج جاهز برنامج حسابات برنامج جاهز برنامج محول التواريخ وبرنامج الاعمار والابراج والصفات برنامج جاهز برنامج حسابات مبسط برنامج جاهز مقياس الحمى برنامج جاهز برنامج حساب لثلاث عملات برنامج جاهز اول مشاركة واقبلوا هديتى المتواضعة برنامج جاهز برنامج الشيكات برنامج جاهز اخيرا برنامج الحضور والانصراف برنامج جاهز نتيجة لــ 178 عام قادم بداية 2007 عليك تجربتها برنامج جاهز احدى الطرق لحساب نسبة معدلات الخصم او الاضافة برنامج جاهز برنامج محاسبى برنامج جاهز برنامج خبور المحاسبى الاصدار الاول برنامج جاهز ادخل الرقم و اعرف اللون برنامج جاهز فـــسر حلمك على الاكسيل برنامج جاهز برنامج خبور المحاسبى الاصدار الثانى برنامج جاهز ساعة ستوب واتش برنامج جاهز هديتى نظام لحساب وصرف الرواتب والبدلات الشهرية برنامج جاهز بورصتى القاهرة والاسكندرية خلال فترة زمنية برنامج جاهز النموذج الخاص بالدمغة النسبية برنامج جاهز هذة لعبة ذكاء مصممة على الاكسل برنامج جاهز ملف مهم للمغتربين المشاركين بالسكن برنامج جاهز كنترول للصف الاول والثانى لمدرسة صناعية مجربة 100% برنامج جاهز برنامج خبور المحاسبى الاصدار الثالث برنامج جاهز برنامج المستودع ومراقبة المخزون برنامج جاهز ميزانية لمحاسبة شركات المقاولات برنامج جاهز برنامج محاسبة شركات المقاولات برنامج جاهز برنامج خبور المحاسبى برنامج جاهز الى جميع المحاسبين والمهتمين بالتحليل المالى برنامج جاهز البرنامج المحاسبى الشهيرQUICKBOOKS برنامج جاهز الميزانية العمومية برنامج جاهز الجرد فى المنشات التجارية برنامج جاهز المرتبات والاجور برنامج جاهز فكرة برنامج للقروض برنامج جاهز برنامج حسابات برنامج جاهز برنامج كامل للقروض برنامج جاهز ملف للمرتبات يحسب ضريبة المرتبات والتامينات الاجتماعية برنامج جاهز نموذج فاتورة متكامل بفورم بامكانية الطباعة برنامج جاهز برنامج مرتبات برنامج جاهز يومية الصندوق الالكترونية برنامج جاهز برنامج رواتب بشكل جديد برنامج جاهز برنامج محاسبى على الاكسل برنامج جاهز نموذج تحليل مدفوعات مصروفات وخلافة برنامج جاهز برنامج كشـف صـرف النقـديـة بالفئات المتاحـة برنامج جاهز برنامج حسابات البنوك * الجديد كلياً برنامج جاهز برنامج توافق الابراج فى اكسل برنامج جاهز توزيع كشوف ملاحظة الامتحانات برنامج جاهز برنامج محاسبة جاهز برنامج جاهز برنامج كاس العالم 2010 بالمعادلات برنامج جاهز برنامج الشهادات المدرسية للمرحلة الاساسية العليا فى فلسطينبرنامج جاهز برنامج جاهز ترحيل سند صرف قبض فاتورة قيود طلب عاجل برنامج جاهز يخص عمليات الاستثمار برنامج جاهز_يومية عملاء و موردين و كشف حساب بين تاريخين برنامج جاهز_يومية مبيعات مع التقرير برنامج جاهز لادارة مكتبه_ترتيب و فهرسة الكتب برنامج جاهز_سركى الصادر و الوارد للمكاتبات و الارشيف برنامج جاهز2_سركى الصادر و الوارد للمكاتبات و الارشيف مع الطباعة و الشرح برنامج جاهز3_سركى متكامل للصادر و الوارد للمكاتبات و الارشيف برنامج جاهز_تحويل صورة و نسخها الى خلايا اكسيل برنامج جاهز_طباعة الشيكات بعملات مختلفه برنامج جاهز_ تذكير بمواعيد انتهاء اوراقك الرسمية برنامج جاهز_ طباعة ايصالات PAYROLL_تلقائيا برنامج جاهز_سند قبض و صرف برنامج جاهز_يومية و كشف حساب بين تاريخين مع اختيار عملة الحساب برنامج جاهز_برنامج احتساب القيمة الحالية للمبالغ و خصم قطع الشيكات بطريقتين برنامج جاهز_برنامج قيود يومية بالترحيل الى يوميات الاستاذ مع عمل كشف حساب برنامج جاهز_بالكود نتائج الطلاب مع الفرز _الناجح و الراسب برنامج جاهز_برنامج حسابات مع صفحات الاستاذ و ارصدة البنوك برنامج جاهز_ لجدولة انشاء و سداد اقساط مجدولة و القروض و العهد برنامج جاهز لادارة مصروفاتك الشخصيه برنامج جاهز لتحويل التاريخ من ميلادى الى هجرى ,والعكس برنامج جاهز_طباعة شيكات بنك_التجارى الدولى_cib_اصدار دفاتر 2018_مع امكانية اضافة بنوك اخرى برنامج جاهز لادارة المصاريف الشخصية برنامج جاهز للمخازن والعملاء والموردين هديتى برنامج جاهز_طباعة شيكات بنك_التجارى الدولى_CIB_مع امكانية اضافة بنوك اخرى