ليلى الهلالي

للرفع

السلام عليكم أسعد الله أوقاتكم بكل خير أستاذي الفاضل عادل تم إرسال المرفق وقد أوضحت فيه المطلوب . وقد جعلني كرمك وحِلمك عليَّ بأن أطمع في طلبين وضحتهما في المرفق. إن كان بإمكانك تنفيذهما فلك جزيل الشكر وإن استصعبت المسألة فلك جزيل الشكر أيضاً ولا داعي أن تتعب نفسك. فقد كفيت ووفيت وجُزيت خيراً عن كل ما قدمته وتقدمه لرواد هذا المنتدى. المواد المدجمة أوفيسنا.xlsx

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

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

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

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

أتبع هذه الراوابط قد تجد فيها ما يفيد https://www.officena.net/ib/topic/89479-طلب-طريقة-فك-حماية-ورقة-اكسل/?tab=comments#comment-563053

السلام عليكم ورحمة الله وبركاته الملف الذي رفعته يبدو أنه معطوب حيث لم يقبل أن يفتح لديّ

السلام عليكم ورحمة الله وبركاته تابع هذا المنتدى وأبحر في صفحاته وسوف تجد الكثير والكثير من المعلومات والدروس المفيدة التي أعدها جهابذة هذا المنتدى والذين لم يبخلوا بشيء من أجل نشر علمٍ يُنتفع به وكذلك رابط آخر للمعادلات وستجد الكثيرVBA هذا رابط لدروس

السلام عليكم أعتذر لعدم تحميل المرفق حيث توقف النت لديّ حافظة الدوام أوفيسنا.rar

السلام عليكم ورحمة الله وبركاته خواتم مباركة ومرضية وجدت كود للأستاذ القدير ياسر خليل وأرجو منكم مساعدتي في معرفة المتغيرات أو الجزئيةأو ما يلزم لتغييره كي يتناسب مع ملفي. حيث أريد أن أرحل المعلمين من حافظة الدوام إلى ملف منفصل لكل مدرسة مع نسخ تنسيقات الحافظة. والكود كالتالي Sub Export_Workbooks_Using_Filter() 'Author : YasserKhalil 'Release : 07 - 09 - 2016 '------------------------ Dim a As Variant Dim I As Long Dim P As Integer Dim cnt As Integer Dim Dic As Object Dim strDir As String Dim Arr() As Double Dim iFlag As Boolean '========================================================= Const firstCol As Long = 1 'First Column Const lastCol As Long = 4 'Last Column Const colNo As Long = 1 'Column To Filter Const sSheet As String = "Sheet1" 'Sheet Name '========================================================= strDir = ThisWorkbook.Path & "\Output\" For P = firstCol To lastCol ReDim Preserve Arr(P - 1) Arr(P - 1) = Sheets(sSheet).Columns(P).ColumnWidth Next P iFlag = Sheets(sSheet).DisplayRightToLeft Call SpeedUp If Dir(strDir, vbDirectory) = "" Then MkDir strDir Sheets.Add before:=Sheets(1) Set Dic = CreateObject("Scripting.Dictionary") Dic.CompareMOde = 1 With Sheets(sSheet).[A1].CurrentRegion .Columns(colNo).Value = Application.Trim(.Columns(colNo).Value) a = .Value .Parent.AutoFilterMode = False For I = 2 To UBound(a, 1) If Not Dic.exists(a(I, colNo)) And Not IsEmpty(a(I, colNo)) Then Dic(a(I, colNo)) = Empty .AutoFilter colNo, a(I, colNo) .Copy Sheets(1).Cells(1) Sheets(1).Copy With ActiveWorkbook With Sheets(1) .Name = "Sheet1" .DisplayRightToLeft = iFlag .Cells(1).CurrentRegion.RowHeight = 19 For cnt = firstCol To lastCol .Columns(cnt).ColumnWidth = Arr(cnt - 1) Next cnt End With .SaveAs strDir & RemoveSpecial(CStr(a(I, colNo))) & ".xlsx" .Close End With Sheets(1).Cells.Clear .AutoFilter End If Next I End With Sheets(1).Delete Call SpeedDown MsgBox "Done...", 64 End Sub Function RemoveSpecial(sInput As String) As String Dim sSpecialChars As String Dim I As Long sSpecialChars = "\/:*?""<>|" For I = 1 To Len(sSpecialChars) sInput = VBA.Trim(Replace$(sInput, Mid$(sSpecialChars, I, 1), " ")) Next I RemoveSpecial = sInput End Function Function SpeedUp() With Application .Calculation = xlManual .ScreenUpdating = False .DisplayAlerts = False .EnableEvents = False End With End Function Function SpeedDown() With Application .Calculation = xlAutomatic .ScreenUpdating = True .DisplayAlerts = True .EnableEvents = True End With End Function

السلام عليكم أخي الفاضل عبدالفتاح شهر مبارك لقد عدلت في الكود وقد قام بعملية الترحيل بحسب ما وضعته أنت في الكود. ولكني لم افهم ما هو المطلوب ترحيله بالضبط هل تريد ترحيل البيانات التي في الأعمدة أم كما هو موجود في المرفق الذي أرسلته؟ جرب الكود قد يكون هو المطلوب Option Explicit Sub transferData() Dim i As Long Dim lastrow As Long Dim erow As Long lastrow = Sheets("æÑÞÉ1").Range("a" & Rows.Count).End(xlUp).Row For i = 3 To lastrow erow = Sheets("æÑÞÉ2").Range("a" & Rows.Count).End(xlUp).Offset(1, 0).Row Range(Cells(i, 1), Cells(i, 6)).Copy Destination:=æÑÞÉ2.Cells(erow, 1) Next i Cells(erow, 6) = WorksheetFunction.Sum(Worksheets("æÑÞÉ2").Range("e3:e35")) End Sub

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

أستاذي الفاضل وائل: أعتذر منك لكني لم أجد المعادلات؟؟

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

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

السلام عليكم حتى الآن لم أجد رداً من أحد وأعذروني فأنا أعلم مدى انشغالكم فأرجو أن أجد من يساعدني. خلال بحثي عن حل لمسألة ترحيل من ورقة عمل إلى ورقة عمل أخرى وجدت هذا الكود في شرح في أحد المواقع الأجنبية أذعه هنا للفائدة العامة وهو كالتالي: Option Explicit Sub Copy_Method() 'Copy range to another workbook using Range.Copy Method 'Copy range to another workbook Workbooks("برنامج القوى العاملة .xlsb").Worksheets("القوى للمدارس").Range("A4:i1900", "N4:n1900").Copy _ Workbooks("حافظة دوام مدارس.xlsb").Worksheets("القوى العاملة").Range("A2:j1900") 'IMPORTANT points to remember: 'Both workbooks must be open. We can use code to open/close workbooks. 'Must reference correct file extensionin Workbooks property. 'Workbooks do NOT have to be macro enabled. 'Code can be stored in separate workbook (PMW). 'Do not need to select or activate the workbooks first. Video on VBA Assumptions. End Sub Sub Copy_PasteSpecial_Method() 'Copy range to clipboard Workbooks("برنامج القوى العاملة .xlsb").Worksheets("القوى للمدارس").Range("A4:i1900", "N4:n1900").Copy _ 'PasteSpecial to paste values, formulas, formats, etc. Workbooks("حافظة دوام مدارس.xlsb").Worksheets("القوى العاملة").Range ("A2:j1900") .PasteSpecial Paste:=xlPasteValues End Sub Sub Copy_Values_Technique() 'Set value of destination range to value of copy range Workbooks("برنامج القوى العاملة .xlsb").Worksheets("القوى للمدارس").Range("A4:i1900", "N4:n1900").Value = _ Workbooks("حافظة دوام مدارس.xlsb").Worksheets("القوى العاملة").Range("A4:j1900").Value End Sub Sub Alternate_Workbook_Reference() 'The ThisWorkbook property can be used if the code is in the same 'workbook as the copy or destination range. In this case the code 'is in the destination workbook. Workbooks("برنامج القوى العاملة .xlsb").Worksheets("القوى للمدارس").Range("A4:i1900", "N4:n1900").Copy _ Workbooks("حافظة دوام مدارس.xlsb").Worksheets("القوى العاملة").Range("A2:j1900") 'Original reference Workbooks("برنامج القوى العاملة .xlsb").Worksheets("القوى للمدارس").Range("A4:i1900", "N4:n1900").Copy _ Workbooks("حافظة دوام مدارس.xlsb").Worksheets("برنامج القوى العاملة .xlsb").Range("A2:j1900") End Sub Sub Sheet_Number_Reference() 'Reference a sheet by its postion (index) number if the sheet name changes frequently. Workbooks("برنامج القوى العاملة .xlsb").Worksheets(1).Range("A4:i1900", "N4:n1900").Copy _ ThisWorkbook.Worksheets("برنامج القوى العاملة .xlsb").Range("A2:j1900") End Sub وقد ساعدني كثيراً يتبقى لي الترحيل من شيت إلى شيت بشروط: 1) إذا كان المدرس إداري اود أن يضع في(خانة العمل ) في حافظة الدوام (عمله: مثلاً أرشيف، مدير ، وكيل ، حاسوب ....وهكذا) 2) أما إن كان معلماً فيضع في (خانة العمل) في حافزة الدوام (مادة التدريس : مثلا لغة عربية ، قرآن ، اسلامية ، رياضيات.....وهكذا) 3) فرز العمل ليكون الإداري في أول الحافظة ثم يتم ترتيب المواد متتالية) أريد أن نبدأ بحل هذه المسألة ثم ننتقل للبقية. · ملاحظة : اضطررت إلى تغيير أسماء المصنفات في الكود للتماشى مع الكود وتسهيل نقل اسم المصنف بشكل أفضل

السلام عليكم في خلال بحثي عن حل وجدت كود يشرح طريقة ترحيل لا أدري هل تنفع أك لا ولكني حاولت تطبيقها فلم أوفق أرجو مساعدتي في تطويعها في عملي. ولكم جزيل الشكر. Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("N:N")) Is Nothing Then Exit Sub Select Case Target.Value Case "عائشة" Sheets("عائشة").Range("B7:c1900").Copy Sheets("القوى للمدارس").Range("n4:n1900") Case "الثلايا" Sheets("الثلايا").Range("B7:c1900").Copy Sheets("القوى للمدارس").Range("n4:n1900") Case "الزهراء" Sheets("الزهراء").Range("B7:c1900").Copy Sheets("القوى للمدارس ").Range("n4:n1900") End Select End Sub

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

السلام عليكم ورحمة الله وبركاته. أسعد الله أوقاتكم بكل خير. أضع بين أيديكم استفساراتي للعمل المطلوب مني إنجازه حيث أني قد بحثت في طيات هذا المنتدى ووجدت الكثير من الإجابات التي لم استطع تطويعها في عملي لقلة فهمي في الأكواد. المطلوب كالتالي: لديَ حافظة دوام حضور وانصراف الموظفين وورقة عمل بالقوى العاملة للمنطقة التعليمية وأريد أن يتم ترحيل اسماء المعلمين والمعلمات من ورقة القوى العاملة إلى ورقة حافظة الدوام على أن يتم إنشاء ورقة لكل مدرسة وفيها جميع المعلمين بحسب الآني: 1) ترحيل بيانات كل مدرسة في ورقة جديدة بحسب النموذج المرفق 2) فرز بحسب العمل (إداري أولاً من العمودين /E4:E64 F4:F64) مثلا إذا كان الموظف اداري نكتب جوار اسمه عمله عمود( العمل الحالي ) فقط إذا كان اداري. 3) فرز بحسب مادة التدريس اذا كان معلماً. أدرجت أمثلة في حافظة الدوام. هناك عدة استفسارات أدرجتها في ورقة العمل إذا أمكن مساعدتي في تنفيذها أو وضع رابط شرح أو فيديو وأنا سأطلع عليه واطبقه. شاكرة لكم مقدماً جهودكم المبذولة في هذا المنتدى الرائع الذي مهما غبت عنه أحن إليه ولو بنظرة إلى جديده. الاستفسار في أوفيسنا.rar

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

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

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

السلام عليكم أخي الفاضل بامكانك استخدام اسهل الطرق كالاتي: أزل القائمة المنسدلة من خلية الصف ثم ضع مكانها هذه المعادلة =$Q$7 وبعدها غير في عمود الفصل ما شئت وسيظهر مباشرة في خلية الصف. هذه إحدى الطرق. أرجو أن تكون مناسبة وتلبي طلبك. ومرفق لك ملفك مع تنفيذ المعادلة. ‏‏اعمال السنة 2018بالمعادلة.rar

السلام عليكم أخي الفاضل waledms هل تريد تغيير الفصل في القائمة المنسدلة أم في عمود الفصل؟ أرجو التوضيح .