حسونة حسين

وعليكم السلام ورحمه الله وبركاته تفضل اخى Option Explicit Sub Tarhil() Dim WS As Worksheet, SH As Worksheet, ARR, LR As Long, P As Long, i As Long, J As Long, K As Long, R As Range Set WS = ThisWorkbook.Worksheets("التسجيل") Set SH = ThisWorkbook.Worksheets("التقيم") LR = Cells(Rows.Count, 1).End(xlUp).Row P = 1 ARR = WS.Range("A10:R" & WS.Range("A" & Rows.Count).End(xlUp).Row).Value ReDim Temp(1 To LR + 1, 1 To UBound(ARR, 2)) For i = 1 To UBound(ARR) For J = 5 To 15 If ARR(i, J) <> "" Then Temp(P, 1) = WorksheetFunction.Max(Columns("AM")) + P For K = 2 To 18 Temp(P, K) = ARR(i, K) Next K If R Is Nothing Then Set R = WS.Cells(i + 9, 1) Else Set R = Union(R, WS.Cells(i + 9, 1)) End If P = P + 1 Exit For End If Next J Next i If Not R Is Nothing Then R.EntireRow.Delete With SH If P > 0 Then .Columns("AP").NumberFormat = "@" .Columns("BC").NumberFormat = "[$-F800]dddd, mmmm dd, yyyy" LR = Application.Max(2, .Cells(Rows.Count, "AM").End(xlUp).Row) .Range("AM" & LR).Resize(P - 1, UBound(Temp, 2)).Value = Temp End If End With End Sub

اخى لكل موضوع طلب منفصل مرفق بملف بعد ما تقوم بإدخال الاكواد التى انتهيت منها موضحا ما تريد

وعليكم السلام ورحمه الله وبركاته اخى @ابو .. عبدالرحمن لكل طلب موضوع منفصل هذا طلبك الاول كود الترحيل (ادخال البيانات) Option Explicit Private arr As Variant, Temp As Variant, X Private J As Long, P As Long Private Sub Insert_Data_Click() If WSData.Range("C8") = "" Then MsgBox " لا بد من تسجيل رقم المعاملة ": Exit Sub kh_Application False ReDim Temp(1 To UBound(AR, 1) + 1) For J = 0 To UBound(AR) Temp(J + 1) = WSData.Range(AR(J)) Next J WSResult.Range("A" & WSResult_LR).Resize(, UBound(Temp, 1)).Value = Temp MsgBox " تم ادخال البيانات بنجاح " Delete_Data_Click kh_Application True End Sub Private Sub Delete_Data_Click() kh_Application False For J = 0 To UBound(AR) WSData.Range(AR(J)) = "" Next J kh_Application True MsgBox " تم حذف البيانات بنجاح " End Sub Sub kh_Application(ibol As Boolean) With Application .ScreenUpdating = ibol .DisplayAlerts = ibol .EnableEvents = ibol End With End Sub Public Function WSData() As Worksheet Set WSData = ThisWorkbook.Worksheets("الرئيسية") End Function Public Function WSResult() As Worksheet Set WSResult = ThisWorkbook.Worksheets("البيانات") End Function Public Function AR() As Variant AR = Array("C8", "C10", "C12", "C14", "C16", "C18", "F8", "F10", "F12", "F14", "F16", "F18", "I8", "I10", "I12", "I14", "I16", "I18") End Function Public Function WSResult_LR() As Long WSResult_LR = Application.Max(1, WSResult.Cells(Rows.Count, 1).End(xlUp).Row) + 1 End Function برنامج المعاملات المالية.xlsm

وعليكم السلام ورحمة الله وبركاته ارفق ملف اخى للعمل عليه ويمكنك الاستفاده من هذا الموضوع وهذا الموضوع

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف هذا الموضوع مخالف لقوانين المنتدي ×××××××× يمنع منعا باتا توجيه السؤال إلى شخص بعينه لان هذا قد يدفع الآخرين إلى عدم الإجابة، والهدف هو التفاعل من الجميع. ×××××××× يغلق ××××××××

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف هذا الموضوع مخالف لقوانين المنتدي ×××××××× انتهاك حقوق الملكيه ×××××××× يغلق ××××××××

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف هذا الموضوع مخالف لقوانين المنتدي ×××××××× موضوع مكرر ×××××××× يغلق ××××××××

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

انا لله وإنا إليه راجعون خبر محزن للتربية والتعليم بمصر والوطن العربي بقلوب مؤمنة بقضاء الله وقدره ننعى إليكم ونعزى أنفسنا فى وفاة المبرمج محمد الشابوري ،، صاحب برنامج المنجز اللهم أدخله برحمتك فسيح جناتك, اللهم أبدله دارا خير من داره وأهلا خيرا من أهله واجعله مع الصديقين والنبيين والشهداء وحسن أؤلئك رفيقـا -اللهم وسع مدخله وغسله بالماء والبرد. جعلك الله من أهل الجنة ...إنه على كل شئ قدير و بالإجابة جدير وإنا لله وإنا اليـه راجعـــــــــون لا حول ولا قوة إلا بالله العلي العظيم انا لله وانا اليه راجعون قال تعالى في كتابه العزيز ( وَلَنَبْلُوَنَّكُمْ بِشَيْءٍ مِنَ الْخَوْفِ وَالْجُوعِ وَنَقْصٍ مِنَ الْأَمْوَالِ وَالْأَنْفُسِ وَالثَّمَرَاتِ وَبَشِّرِ الصَّابِرِينَ * الَّذِينَ إِذَا أَصَابَتْهُمْ مُصِيبَةٌ قَالُوا إِنَّا لِلَّهِ وَإِنَّا إِلَيْهِ رَاجِعُونَ * أُولَئِكَ عَلَيْهِمْ صَلَوَاتٌ مِنْ رَبِّهِمْ وَرَحْمَةٌ وَأُولَئِكَ هُمُ الْمُهْتَدُونَ )

السلام عليكم ورحمة الله وبركاته وبها نبدأ @دم الغزال استبدل هذا السطر Application.SendKeys ("{ESC 2}") بهذا السطر Application.CutCopyMode = False وان استمر الخطأ ارفق ملف للعمل عليه

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف هذا الموضوع مخالف لقوانين المنتدي ×××××××× اكثر من طلب في موضوع واحد. ×××××××× يغلق ×××××××× الإدارة

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف هذا الموضوع مخالف لقوانين المنتدي ×××××××× اكثر من طلب في موضوع واحد. يجب أن يكون عنوان المشاركة يدل على محتواها ×××××××× يغلق ×××××××× الإدارة

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

اخي @ss20_a2 قبل كلمه Function ضع Ptrsafe لتصبح هكذا Declare PtrSafe Function

تفضل اخي عدل هذا السطر If (X.Row < 600 And X.Column < 12) Then الى If (X.Row >= 100 and X.Row <= 120 And X.Column < 4) Then

وعليكم السلام ورحمه الله وبركاته اخي @ابوعلي الحبيب الكود الخاص بك في المشاركه الاولي ليس به اي مشكله لكن تأكد ان المسار الذي تحفظ به الصورة موجود وهذا كود اخر بسيط سوف يقوم بإنشاء المسار ان لم يكن موجود ويحفظ الصورة Option Explicit Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Boolean Sub Export_Range_As_Picture() Dim Ws As Worksheet, StrToFolder2 As String Dim oRng As Range, sPath As String, oChart As ChartObject Set Ws = ActiveSheet Application.ScreenUpdating = False StrToFolder2 = "D:\pic\" MakeSureDirectoryPathExists StrToFolder2 sPath = StrToFolder2 & Ws.Range("a1").Value & "." & "jpg" Set oRng = Ws.Range("A3:H17") oRng.CopyPicture xlScreen, xlPicture Set oChart = Ws.ChartObjects.Add(Left:=0, Top:=0, Width:=oRng.Width * 1, Height:=oRng.Height * 1) With oChart .Activate .Chart.Paste .Chart.Export Filename:=sPath .Delete End With Application.ScreenUpdating = True End Sub

الحمد لله تم المطلوب اخى @ehabaf2

وعليكم السلام ورحمه الله وبركاته جرب هذا التعديل اخي @ehabaf2 Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim X As Range For Each X In Target ' 600 هو اخر سطر لعمل الكود 'L هو العامود column 12 If (X.Row < 600 And X.Column < 12) Then If ActiveSheet.ProtectContents = True And X.Value <> "" Then X.Offset(0, 1).Select End If Next End Sub عدم التعديل فى اسطر محددة.xlsb

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

وعليكم السلام ورحمة الله وبركاته قواعد المشاركة بمنتدي أوفيسنا بالنسبه لطلبك الأول هو موجود فعليا في البند رقم ٢٣ 23. ممنوع نهائيا وبشكل قاطع تكرار الموضوع نفسه أو فتح موضوع جديد للمطالبة برد في موضوع سابق، كما يمنع منعا باتا ذكر أكثر من سؤال في نفس الموضوع، وهذا لكي يسهل البحث والحصول على المعلومة على من بعدك بالنسبه لطلبك الثانى هو موجود فعليا في البند رقم ١٩ 19. تجنب نشر بيانات حقيقية يخشى نشرها ويمكن أن تطلب حذفها لاحقاً

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف هذا الموضوع مخالف لقوانين المنتدي ×××××××× موضوع مكرر ×××××××× يغلق ×××××××× الإدارة

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

اخي @2saad كل موضوع له طلب واحد تم غلق الموضوع

وعليكم السلام ورحمة الله وبركاته Portable Ontrack EasyRecovery Technician 16.0.0.2 Multilingual

السلام عليكم ورحمة الله وبركاته وبها نبدأ الشيت محمي فك الحمايه عن الشيت اولا