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

يسرني ويسعدني أن أضع بين يديكم برنامج التدريب الالكتروني قمت بتصميمه من الصفر أخذ مني جهد ووقت كبير . استفدت من خبراء هذا المنتدى المبارك. لي طلب أن تدعو لوالدي وجميع مرضى المسلمين والمسلمات بالشفاء العاجل. هذا المشروع أضعه صدقة جارية لكل طالب علم ، و كل مشارك في هذا المنتدى . أسأل الله أن يتقبل منا ومنكم صالح الأعمال . ولا تنسونا من دعواتكم الصادقة في ظهر الغيب . اترك البرنامج لكم لتكتشفوا أسراره 😄 اضف مرفقات موجوده ProTraining20.zip

لعكس الترتيب استبدل قي هذا السطر من الكود الرقم 2 بالرقم 1 Dash.Range("A3").CurrentRegion.Sort Dash.Range("E3"), 2, Header:=1 تم التعديل على الملف كما تريد ( و زيادة حبتين من حيث التنسيق) Option Explicit Sub From_dash_to_data() Dim Dash As Worksheet, Dt As Worksheet Dim Cret As Range, x%, y%, Ro_D Application.ScreenUpdating = False Set Dash = Sheets("Dashboard"): Set Dt = Sheets("DATA") Dash.Range("A3").CurrentRegion.Clear Ro_D = Dt.Range("A3").CurrentRegion.CurrentRegion.Rows.Count If Dash.Range("C1") = "" Then MsgBox "Pleae Type A number In The cell C1" & Chr(10) & _ "Last Than " & Ro_D - 2 GoTo Bay_Bay End If If Not IsNumeric(Dash.Range("C1")) Then MsgBox "Tex Not Allowed in The cell C1" & Chr(10) & _ "Pleae Type A number" GoTo Bay_Bay End If y = Int(Abs(Dash.Range("C1"))) Dash.Range("C1") = y Set Cret = Dash.Range("A1") Dt.Range("A1").CurrentRegion.AutoFilter 1, Cret Dt.Range("A1").CurrentRegion.SpecialCells(12).Copy Dash.Range("A3").PasteSpecial (12) Dash.Range("A3").CurrentRegion.Sort Dash.Range("E3"), 2, Header:=1 x = Dash.Range("A3").CurrentRegion.CurrentRegion.Rows.Count If x - y < 2 Then With Dash.Range("A4").Offset(x - 1, 2) .Value = Evaluate("=SUM(C4:C" & x + 2 & ")") .Interior.ColorIndex = 3 .Font.ColorIndex = 2 End With Else Dash.Range("A4").Offset(y) _ .Resize(x - y - 1).EntireRow.Delete With Dash.Range("A3").Offset(y + 1, 2) .Value = Evaluate("=SUM(C4:C" & y + 3 & ")") .Interior.ColorIndex = 3 .Font.ColorIndex = 2 End With End If Application.CutCopyMode = False If Dt.AutoFilterMode Then Dt.Range("A1").AutoFilter Dash.Activate With Dash.Range("A3").CurrentRegion .Borders.LineStyle = 1 .InsertIndent 1 .Font.Bold = True .Font.Size = 14 .Rows(1).Interior.ColorIndex = 35 .Rows(1).HorizontalAlignment = 3 End With Dash.Range("A3").Select Bay_Bay: Application.ScreenUpdating = True End Sub الملف من جديد Hashem_Super.xlsm

يجب ابقاء الصف رقم 2 فارغاً (لقصل البيانات المتغيرة عن الثابتة) تم اخفاءه والبيانات تبدأ من الصف رقم 3 الماكرو Option Explicit Sub From_dash_to_data() Dim Dash As Worksheet, Dt As Worksheet Dim Cret As Range, x%, y% Set Dash = Sheets("Dashboard"): Set Dt = Sheets("DATA") If Not IsNumeric(Dash.Range("C1")) Then Exit Sub End If y = Int(Abs(Dash.Range("C1"))) Dash.Range("C1") = y Dash.Range("A3").CurrentRegion.ClearContents Set Cret = Dash.Range("A1") Dt.Range("A1").CurrentRegion.AutoFilter 1, Cret Dt.Range("A1").CurrentRegion.SpecialCells(12).Copy Dash.Range("A3").PasteSpecial (12) Dash.Range("A3").CurrentRegion.Sort Dash.Range("E3"), 2, Header:=1 x = Dash.Range("A3").CurrentRegion.CurrentRegion.Rows.Count Dash.Range("A4").Offset(y) _ .Resize(x - y - 1).EntireRow.Delete Dash.Range("A3").Offset(y + 1, 2) = _ Evaluate("=SUM(C4:C" & y + 3 & ")") Application.CutCopyMode = False If Dt.AutoFilterMode Then Dt.Range("a1").AutoFilter Dash.Activate Dash.Range("A3").Select End Sub File Included Hashem.xlsm

ملف لحساب العمر بالسنين والشهور والأسابيع والأيام والساعات والدقائق والثواني 0003 حاسبة العمر.xlsx

وعليكم السلايمكنك استخدام هذا الكود لذلك Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If (Not Application.Intersect(Target, Me.Range("d9:M18,D19:E19")) Is Nothing) Then Cancel = True Target.Interior.ColorIndex = 15 End If End Sub Cells Colored.xlsm

جرب هذا الماكرو Option Explicit Sub test() Dim Ro%, Rg As Range Dim x%, t%, i% With Sheets("ورقة1") Ro = .Cells(Rows.Count, 1).End(3).Row Set Rg = .Range("A1:A" & Ro).SpecialCells(2, 23) .Range("E1").Resize(Ro, 2).Clear t = 1 For x = 1 To Rg.Areas.Count .Cells(t, "E").Resize(Rg.Areas(x).Rows.Count) = _ Rg.Areas(x).Cells(1, 1) .Cells(t, "E").Interior.ColorIndex = 6 For i = 2 To Rg.Areas(x).Rows.Count .Cells(t + 1, "F").Offset(i - 2) = _ Rg.Areas(x).Cells(i).Offset(, 2) Next i t = t + Rg.Areas(x).Rows.Count + 1 Next x With .Range("E1").Resize(Ro, 2).SpecialCells(2, 23) .Borders.LineStyle = 1 .Font.Bold = True .InsertIndent 1 End With End With End Sub الملف مرفق Sakr_Khalige.xls

حسب فهمي للموضوع: فقط اضغط على المربع الأزرق جمع خلايا.xlsm

كما انه من فترة تم افتتاح اقسام تحص ما يتعلق بالبحث العلمي بالذكاء الاصطناعي و برمجته و البيانات الضخمة ، و منها قسم للبايثون و لكن للاسف لم يحدث فيها تفاعل ملحوظ حتى الان https://www.officena.net/ib/forum/174-البحث-العلمي-و-علوم-البيانات/

السلام عليكم ان لغة البايثون هي لغة برمجة تتميز بانها مفتوحة المصدر و سهلة الاستخدام مقارنة ببعض اللغات الاخرى ، يمكن ان تستخدم فى العديد من الامور و تشتهر فى مجالات التحليل الاجصائي و تطبيقات الذكاء الاصطناعي و برمجة الالعاب فضلا عن بناء عدد كبير من انواع البرامج الاخرى https://ar.wikipedia.org/wiki/بايثون_(لغة_برمجة) اما الاكسيس فهو احد اشهر تطبيقات قواعد البيانات ـ و و هو ليس تطبيق مجاني و جزء من حزمة الاوفس لشركة مايكروسوفت ، و يقبل ايضا البرمجة بلغة فيجوال بيزيك التطبيقات https://ar.wikipedia.org/wiki/مايكروسوفت_أكسس لذا فلبس هناك مقارنة بالمعنى المفهوم ، و انما كل منها ميسر لما أنشء من اجله

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

هذه الكلمه وغيرها من الكلمات يجب على المبرمج ان ينساها تماما ........... جرب المرفق ...... مثال.accdb

جرب هذه الكود تحت نفس زر التصدير بعد مسح الكود القديم الصق هذا الكود On Error Resume Next CurrentDb.Execute ("Delete * From temp") DoCmd.SetWarnings False DoCmd.RunSQL " SELECT qryElemnts1.stname INTO temp " & _ " FROM qryElemnts1;" DoCmd.SetWarnings True Dim TheFile As String Dim BackFile As String Dim lngColumn As Long Dim xlx As Object, xlw As Object, xls As Object, xlc As Object Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim blnEXCEL As Boolean, blnHeaderRow As Boolean blnEXCEL = False blnHeaderRow = False On Error Resume Next Set xlx = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set xlx = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 xlx.Visible = True TheFile = CurrentProject.Path & "\ms.xlsx" BackFile = CurrentProject.Path & "\äÓÎÉ ÇÍÊíÇØíÉ ãä ms.xlk" Set xlw = xlx.Workbooks.Open(TheFile) Set xls = xlw.Worksheets("students") 'ÇÓã æÑÞÉ ÇáÚãá Set xlc = xls.Range("B6") 'Çæá ÎáíÉ Ýí ãáÝ ÇáÇßÓá ÊÈÏà ÇáÊÚÈÆÉ ãäåÇ Set dbs = CurrentDb() Set rst = dbs.OpenRecordset("temp", dbOpenDynaset) 'ÇÓã ÇáÇÓÊÚáÇã If rst.EOF = False And rst.BOF = False Then rst.MoveFirst If blnHeaderRow = True Then For lngColumn = 0 To rst.Fields.Count - 1 xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).name Next lngColumn Set xlc = xlc.Offset(1, 0) End If Do While rst.EOF = False For lngColumn = 0 To rst.Fields.Count - 1 rst.Edit 'rst!datasheat = rst!stname & HyperlinkPart(rst.Fields("datasheat"), acAddress) rst.Update xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value Next lngColumn rst.MoveNext Set xlc = xlc.Offset(1, 0) Loop End If rst.Close Set rst = Nothing dbs.Close Set dbs = Nothing Set xlc = Nothing Set xls = Nothing xlw.Close True Set xlw = Nothing If blnEXCEL = True Then xlx.Quit Set xlx = Nothing Kill (BackFile)

اعتقد المشكلة في نوع الاستعلام لانه يعتمد على التصفية في النموذج ..... الحل المؤقت : هو انشاء جدول مؤقت Temp من الاستعلام qryElemnts ثم تربط ما تريد به مباشرة ويتم حذفة بعد تصدير البيانات مباشرة

السلام عليكم امتداداً لتطويرات برنامج الخليل المحاسبي يسرني أهدي لكم الإصدار الثاني مع تعديلات وإضافات جميلة كما أشكر أستاذي الفاضل @sandanet لقد استفدت من طريقته في الحماية حسب مشاركته القيمة : اترك لكم البرنامج . وآملاً أن اتلقى ملاحظاتكم القيمة بعد استخدام البرنامج . تقبلوا فائق المحبة والتقدير BuySal20_V14.accdb BuySal20_V14.accdb.mdb.zip

احسنت النشر بارك الله فيك

السلام عليكم ورحمة الله وبركاته مساهمة مع أستاذنا @محمد أبوعبدالله انظر الي هذا المرفق بالمشاركة التالية لعله يفيدك بشئ

ماشاء الله عليك استاذ سليم تقوم بتنفيذ احسن من ما اتمناه تسلم يدك وعقلك وبارك الله في علمك وجعله في وازين حسناتك

اضغط على OK لترى اين المؤشر يقف اذا وقف عند الفاصلة فعليك باستبدالها ; لاختلاف اصدرات الاوفيس

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

ما شاء الله لا قوة الا بالله عمل عظيم ومفيد ان شاء الله للجميع غفر الله لك ولوالديك وحزاك الله خيرا اخي الكريم تحياتي

وعليكم السلام تفضل أخي الكريم ... شوف التعديل هل هذا هو المطلوب. جرب ووافينا بالنتيجة . تحياتي za-EmployyeUP.accdb

هذا لأن حضرتك تستخدم ويندوز 32 بت لذلك تم حذف البرنامج وجاري عمل نسخة متوافقة مع ويندوز 32 و 64 حاول تحميل البرنامج غدا ان شاء الله عندما نقوم برفعه مرة اخرى واياكم استاذنا أحمد يوسف ان شاء الله سوف يتم حل المشكلة غدا وتثبت الموضوع مرة اخرى🙂

عذراً استاذى الكريم بن علية - ولكن أعتقد ان صاحب المشاركة يريد جلب أسماء الطلاب لكل مادة عند اختيار اسم المادة من القائمة المنسدلة الموجودة بالخلية K10 ويتم جلب أسماء الطلاب ابتداءاً من الخلية K11 الى الأسفل وتم الإستعانة بمعادلة حضرتك بعد تطويعها لهذا الأمر 0001.xlsx

السلام عليكم لست أدري إن كان ما تريده موجود في الملف المرفق... 0000.xlsx

اتفضل حسب فهمي لطلبك استخدمت هذه الاكواد Public Sub a_AfterUpdate() If Len(Me.a & "") <> 0 And Len(Me.b & "") = 0 And Len(Me.C & "") = 0 Then Me.Filter = "[Safe]='" & Me.a & "'" Me.FilterOn = True ElseIf Len(Me.a & "") <> 0 And Len(Me.b & "") <> 0 And Len(Me.C & "") = 0 Then Me.Filter = "[Safe]='" & Me.a & "'" & "and [Sub]='" & Me.b & "'" Me.FilterOn = True ElseIf Len(Me.a & "") <> 0 And Len(Me.b & "") <> 0 And Len(Me.C & "") <> 0 Then Me.Filter = "[Safe]='" & Me.a & "'" & "and [Sub]='" & Me.b & "'" & "and [Class]='" & Me.C & "'" Me.FilterOn = True ElseIf Len(Me.a & "") = 0 And Len(Me.b & "") <> 0 And Len(Me.C & "") <> 0 Then Me.Filter = "[Sub]='" & Me.b & "'" & "and [Class]='" & Me.C & "'" Me.FilterOn = True ElseIf Len(Me.a & "") = 0 And Len(Me.b & "") = 0 And Len(Me.C & "") <> 0 Then Me.Filter = "[Class]='" & Me.C & "'" Me.FilterOn = True ElseIf Len(Me.a & "") <> 0 And Len(Me.b & "") = 0 And Len(Me.C & "") <> 0 Then Me.Filter = "[Safe]='" & Me.a & "'" & "and [Class]='" & Me.C & "'" Me.FilterOn = True ElseIf Len(Me.a & "") = 0 And Len(Me.b & "") <> 0 And Len(Me.C & "") = 0 Then Me.Filter = "[Sub]='" & Me.b & "'" Me.FilterOn = True ElseIf Len(Me.a & "") = 0 And Len(Me.b & "") = 0 And Len(Me.C & "") = 0 Then Me.Filter = "" Me.FilterOn = False End If End Sub Private Sub b_AfterUpdate() Call a_AfterUpdate End Sub Private Sub BtnCancelFilter_Click() Me.a = "": Me.b = "": Me.C = "": Me.Filter = "": Me.FilterOn = False End Sub Private Sub C_AfterUpdate() Call a_AfterUpdate End Sub اليك ملفك بعد اضافة Database1.rar

بارك الله فيك وزادك الله من فضله

طيب انشأ نموذج وضع فيه زر وضع تحث حدث عند النقر للزر هذا الكود ..... Dim fpath As String fpath = Application.CurrentProject.Path & "\New Microsoft Excel Worksheet.xlsx" DoCmd.TransferSpreadsheet acImport, 8, "Table1", fpath, True

وعليكم السلام ورحمة الله وبركاته ضع هذا الكود في وحدة نمطية جديدة Function fnAutoField() As String Dim strRndNo As String 10: strRndNo = Format((999999999 * Rnd) + 1, "100000000") If DCount("*", "tblItems", "BarcodeItem='" & strRndNo & "'") > 0 Then GoTo 10 fnAutoField = strRndNo End Function وهذا الكود في النموذج يتأكد من وجود قيمة في BarcodeItem وإلا يضع باركود جديد If IsNull([BarcodeItem]) Then Me!BarcodeItem = fnAutoField() End If

بعد تسطيب البرنامج ظهرت هذه الرسالة

ولكن في فرق في اسماء العناويين بين ملف الاكسس وملف الاكسل هناك فرق بين كود_الصنف و كود الصنف ارجو الرد ؟؟؟

Try this macro Option Explicit '''''''''''''''''''''''''''''''''''' Dim LR%, Ro%, S_rg As Range Dim F_rg As Range, Where As Range Dim i%, t%, LRK%, x%, m% Dim y1%, y2%, ro_source% '++++++++++++++++++++++++++++++++++++++++ '++++++++++++++++++++++++++++++++++++++++ Sub TEST() Rem Created By Salim Hasbaya On 8/10/2020 _ This macro working with merged cells _ And sort Alpha the Data Application.ScreenUpdating = False Dim Col As Object Set S_rg = Source.Range("A3").CurrentRegion Set Col = CreateObject("System.Collections.ArrayList") Ro = S_rg.Rows.Count SALIM.Range("K:K").ClearContents SALIM.Range("A3").CurrentRegion.Clear If Ro = 1 Then Exit Sub Set S_rg = S_rg.Offset(1).Resize(Ro - 1) For i = 3 To Ro + 2 t = Source.Cells(i, 2).MergeArea.Rows.Count If Not Col.Contains(Source.Cells(i, 2).Value) Then Col.Add Source.Cells(i, 2).Value End If i = i + t Next If Col(Col.Count - 1) = "" Then Col.Remove Col(Col.Count - 1) End If Col.Sort SALIM.Range("K1").Resize(Col.Count) = _ Application.Transpose(Col.toarray) Set Col = Nothing Application.ScreenUpdating = True End Sub '+++++++++++++++++++++++++++++++++++ Sub get_data() Application.ScreenUpdating = False TEST Dim p%, Merge_Rg As Range ro_source = Source.Cells(Rows.Count, 2).End(3).Row Set Where = Source.Range("B1:B" & ro_source) LRK = SALIM.Cells(Rows.Count, "K").End(3).Row m = 3 For x = 1 To LRK Set F_rg = Where.Find(SALIM.Cells(x, "K"), Lookat:=1) If Not F_rg Is Nothing Then y1 = F_rg.Row: y2 = y1 Do t = F_rg.MergeArea.Rows.Count SALIM.Cells(m, 2) = Source.Cells(y2, 2) SALIM.Cells(m, 4) = Source.Cells(y2, 4) SALIM.Cells(m, 2).Resize(t).Merge SALIM.Cells(m, 4).Resize(t).Merge Set Merge_Rg = Source.Cells(y2, 1).Resize(t) For p = 1 To Merge_Rg.Rows.Count SALIM.Cells(m, 1).Offset(p - 1) = _ Merge_Rg.Cells(p) SALIM.Cells(m, 3).Offset(p - 1) = _ Merge_Rg.Cells(p).Offset(, 2) Next m = m + t Set F_rg = Where.FindNext(F_rg) y2 = F_rg.Row If y2 = y1 Then Exit Do Loop End If Next With SALIM.Range("A3").CurrentRegion .Borders.LineStyle = 1 .InsertIndent 1 .Font.Size = 16: .Font.Bold = True .HorizontalAlignment = 3 .VerticalAlignment = 2 .Interior.ColorIndex = 35 End With SALIM.Range("K:K").ClearContents Application.ScreenUpdating = True End Sub File Included Abd_Naser.xlsm

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

تم تشغيل الصفحة الثانية من اليوزر (Chrecher) 1- في هذه الصفحة اضغط على الكومبوبوكس قتظهر لك البيانات في التكست بوكسات 2- قم بنعديل ما تريد ثم أضغظ الزر (Modifier) لتنتقل البيانات الى الصفجة test1 RJS .xlsm

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

تفضل لك ما طلبت قائمة منسدلة.xlsx

غير في نمط الخط الى نمط وورد 2007 والسلام

اخى @ابوصلاح قبل تشغيل النموذج انظر للجدول الثانى ستجده فارغ شغل النموذج سيتم الحاق ID للجدول الثانى وتحديث بيانات الرقم القومى بالجدول الثانى وظهور البيانات كامله بالنموذج بعد الالحاق والتحديث تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق تحديث تاريخ الميلاد من الرقم القومي.rar

السلام عليكم و رحمة الله و بركاته الاخوة الاحباب بالمنتدى أقدم اليكم قاعدة بيانات للموارد البشرية HR الاصدار الثاني كلمة المرور : 111 و أسأل الله العلى العظيم أن ينفعكم بهذا العمل و الله الموفق والمستعان و السلام عليكم ورحمة الله و بركاته HR 3 with listbox.rar HR for Windows 8 FADILA.rar

السلا عليكم ورحمة الله وبركاته شهر مبارك وكل عام وانتم بخير كود لتحويل المعادلات الى قيم Option Explicit Sub Kh_Formula_To_Value() Dim MyCalcu As XlCalculation With Application MyCalcu = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With '===================================== '////////////////////////////////////// '===================================== ' هنا تضع النطاق والمعادلة التي تريد تحويلها قيم ' Formula_To_Value باستخدام '===================================== ' T هنا المعادلة اللي في العمود Formula_To_Value Range("T5:T30"), "=RC[-2]*RC[-1]" ' x هنا المعادلة اللي في العمود ' مثل عمل كود الاخ كيماس Formula_To_Value Range("X5:X30"), "=IF(COUNTIF(RC16:R30C16,RC16)=1,SUMPRODUCT((R5C16:R1500C16=RC16)*(R5C20:R1500C20)),"""")" ' Y هنا المعادلة اللي في العمود Formula_To_Value Range("Y5:Y30"), "=SUMPRODUCT((R5C16:R1500C16=RC16)*(R5C20:R1500C20))" '===================================== '////////////////////////////////////// '===================================== With Application .ScreenUpdating = True .Calculation = MyCalcu End With End Sub ================================================= Sub Formula_To_Value(MyRng As Range, MyFormula As Variant) With MyRng .ClearContents .Formula = MyFormula .Cells = .Value End With End Sub وهو طلب احدهم في الموضوع http://www.officena.net/ib/index.php?showtopic=37827 المرفق ملف اكسل 2003 كود تحويل المعادلات الى قيم.rar

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

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

السلام عليكم الاخ الاستاذ الحبيب سعد عابد دائماً سباقون لعمل الخير جزاك الله كل خير وتقبل الله منا ومنكم صالح الأعمال الاخ الفاضل avogadrow اعذرني اخي على التأخير في الرد كنا في الحج جرب المرفق وابلغني والسلام عليكم New_SOP_CODES_alidroos2.rar

السلام عليكم و رحمة الله يمكنك يضاً اخي تنفيذ طلبك من خلال التنسيق الشرطي شاهد الملف المرفق Conditional Formatting - Yahya Hussien.rar

السلام عليكم تفضل يا اخي الحل من وجهي نظري انتظر رد وشكرا Excel Shortcuts reference MAHMOUDFOXMAM.rar

تم عمل اللازم بخصوص التلوين واصبح المدى اوتوماتيكياً بخصوص الملاحظة الاخرى تركت لك تعليق في الملف ابواحمد collection test2011.rar

النشرة الدورية لمواضيع المنتدى http://www.officena.net/team/news/news%2001.htm و سيتم توزيع الوصلة بالبريدعلى جميع الاعضاء و ستصدر النشرة دوريا بصورة نصف شهرية بإذن الله تعالى مرفق الملف فى صيغة Pdf مع الشكر و التقدير للاخ عبد الله المجرب على جهوده news 01.rar

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