أبو عبد الرحمن سعيد

السلام عليكم بعد إذن إخوانى الافاضل الاستاذ القدير / ابو خليل والاستاذ القدير / احمد يعقوب والاستاذ القدير / ياسر العربى وبعد هذه الحلول الرائغة اسمحوا لى بهذة الاضافة على الاخ / ناصر ان يضع كود التنسيق لآخى القدير الحاج / احمد يعقوب فى بداية كود استدعاء البيانات ليتم استدعاؤها على النحو المطلوب ليصبح الكود هكذا Sub MACRO1() 'äÓÎ ÊäÓíÞ æÑÞÉ 2 Çáì ßá ÇæÑÇÞ ÇáãáÝ Dim RN1 As Range, SH, ER ' Sheets("æÑÞÉ2").Select Sheets("æÑÞÉ2").Range("A9:J9").Copy For SH = 2 To Sheets.Count ER = Sheets(SH).UsedRange.Rows.Count Set RN1 = Sheets(SH).Range("A8:J" & ER) RN1.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False RN1.PasteSpecial Paste:=xlPasteColumnWidths Next SH Application.CutCopyMode = False End Sub Sub test() Dim Col As New Collection, Arr, i As Long, J As Long On Error Resume Next Arr = Sheet1.Range("A7:J" & Sheet1.Cells(Rows.Count, "A").End(xlUp).Row).Value For i = 2 To UBound(Arr, 1) For J = 2 To UBound(Arr, 2) Col.Add Key:=J & Chr(2) & Arr(i, 1), Item:=Arr(i, J) Next J Next i With Sheet2.Range("A7:J" & Sheet2.Cells(Rows.Count, "A").End(xlUp).Row) Arr = .Value For i = 2 To UBound(Arr, 1) For J = 2 To UBound(Arr, 2) Arr(i, J) = Col(J & Chr(2) & Arr(i, 1)) Next J Next i .Value = Arr End With End Sub Sub Bring_Data() Dim i As Long Dim K As Long Dim LastRow As Integer Dim SourceSheet As Worksheet Set SourceSheet = ThisWorkbook.Sheets("sheet3") LastRow = SourceSheet.Range("e" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False Range("E7").Select K = 0 For i = 8 To LastRow + 8 Step 20 SourceSheet.Range("E" & i & ":V" & i + 19).Copy Range("A" & K + i).Select ActiveSheet.Paste K = K + 7 Next Application.ScreenUpdating = True End Sub Sub Clear_Data() Dim LastRow As Integer LastRow = Range("a" & Rows.Count).End(xlUp).Row Range("A8:V" & LastRow).Clear End Sub Sub Clear_Sheet2_Data() Dim LastRow As Integer LastRow = Sheet2.Range("a" & Rows.Count).End(xlUp).Row Sheet2.Range("B8:J" & LastRow).Clear End Sub Sub Call_All() Dim myConfirm myConfirm = MsgBox("åá ÊÑíÏ äÓÎ ÇáÊäÓíÞÇÊ", vbYesNo) If myConfirm = vbYes Then MACRO1 myConfirm = MsgBox("åá ÊÑíÏ ÇÓÊÏÚÇÁ ÇáÈíÇäÇÊ", vbYesNo) If myConfirm = vbYes Then test myConfirm = "" myConfirm = MsgBox(" åá ÊÑíÏ ÊÑÍíá ÇáÈíÇäÇÊ", vbYesNo) If myConfirm = vbYes Then Sheet5.Select Bring_Data Sheet2.Select End If myConfirm = "" myConfirm = MsgBox("åá ÊÑíÏ ãÓÍ ãÍÊæíÇÊ äØÇÞ ÇáÈíÇäÇÊ", vbYesNo) If myConfirm = vbYes Then Clear_Sheet2_Data myConfirm = "" myConfirm = MsgBox("åá ÊÑíÏ ÇáÈÏÁ Ýì äÞá ÇáÈíÇäÇÊ áØÈÇÚÉ ÇáßÔæÝ", vbYesNo) If myConfirm = vbYes Then StartTimer End Sub أرجو أن أكون قد وفقت فى تقديم مايصبوا اليه أخى الفاضل ناصر المصرى تقبلوا جميعا وافر احترامى وجزاكم الله خيرا

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

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

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

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

السلام عليكم جميعا ورحمته الله وبركاته أخى الفاضل الاستاذ // رضا راغب أهلا وسهلا بك أخى الكريم بين إخوانك المتميزين خلقا وعلما وأدبا وبعد إذن اخى الحبيب // ياسر خليل " أبو البراء " وإثراءا للموضوع إليك هذا الكود وبإذن الله تعالى ستجد حلا للموضوع جزاكم الله خيرا وبارك فيكم Private Const cRunWhat = "Tarhil_Values" Private RunWhen As Double, Arr() As Range, CurIndex As Long Public Sub StartTimer() Dim A As Areas, I As Long If RunWhen > 0 Then MsgBox "The Process Is Already Running" Exit Sub End If Set A = Sheets("Sheet1").Columns("A").SpecialCells(2, 1).Areas ReDim Arr(1 To A.Count) For I = 1 To A.Count Set Arr(I) = A(I).CurrentRegion Next I CurIndex = 0 RunWhen = Now + TimeSerial(0, 0, 10) Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=True End Sub Public Sub StopTimer() On Error Resume Next Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=False RunWhen = -1 MsgBox "Transferring Data Will Be Turned Off" End Sub Private Sub Tarhil_Values() CurIndex = CurIndex + 1 If CurIndex > UBound(Arr) Then StopTimer Exit Sub End If Arr(CurIndex).Copy Sheets("Sheet2").Cells(Arr(CurIndex).Row, "C") Application.CutCopyMode = False RunWhen = Now + TimeSerial(0, 0, 10) Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=True End Sub

للرفع

للرفع

السلام عليكم جميعا ورحمته الله وبركاته نظرا لاضافة عمود بورقة بيانات العاملين تم تعديل المرفق على النحو المطلوب بحول الله تعالى وافر تقديرى واحترامى ترحيل بيانات السادة العاملين بدلالة الرقم القومى - سعيد بيرم +11.rar

للرفع

للرفع

للرفع

للرفع

للرفع

للرفع

للرفع

للرفع

للرفع

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

للرفع

بسم الله الرحمن الرحيم وبه نستعين السادة الزملاء الافاضل السلام عليكم جميعا ورحمته الله وبركاته وكل عام انتم جميعا بمناسبة عيد الاضحى المبارك أعاده الله علينا وعليكم وعلى الامة الاسلامية والعربية باليمن والبركات سائلا المولى العلى القدير أن يمتعكم بالصحة والعافيه فى أبدانكم بالمرفق التالى قائمة أسماء مؤبجدة مدون بها بيانات السادة العاملين وتتكون فى واقع الامر لآكثر من 8000 من السادة العاملين بالجهة علما بأنه مايتم إنتدابه من السادة العاملين أعدادا أقل من هذا العدد فعلى سبيل المثال تم انتداب 3250 فقط من أصل 8000 ويتم العمل هنا من خلال البحث عن الموظف بموجب الرقم القومى الخاص به وذلك وفقا لما يرد من بيانات مسلسلة غير مؤبجدة فعملية البحث هنا عن كل موظف عملية تستغرق وقتا طويلا هذا من جهة ومن جهة أخرى رأيت أن تنفيذ هذا الامر بالمعادلات أمر غير مُجدى نظرا لما تسبب فى ثقل كبير فى الملف المطلوب بحول الله تعالى أولا :- كود برمجى يقوم بتنفيذ عملية الترحيل من ورقة " بيانات العاملين " مع جلب كافة البيانات قرين كل أسم بدلالة الرقم القومى المدون بالعمود B2 لكل 20 اسم مع ترك عدد 6 صفوف فارغة الى ورقة " المستحقون" علما بأن الترحيل هنا من الاعمدة K : D من ورقة " بيانات العاملين " الى الاعمدة I : B بورقة " المستحقون " ثانيا :- إضافة أمر بالكود المبين بالموديول رقم 1 بورقة " البرنامج " من شأنه نسخ عدد الــ 20 أسم المقابله للأسماء المدونه بورقة " المستحقون " على أن تكون بموجب رسالة " هل تريد نسخ الاسماء المقابله " ثم رساله بنعم او لا ليصبح ترتيب عمل الكود مع الضغط على مفتاح F2 على النحو التالى :- 1 – رسالة بنسخ الاسماء المقابله بورقة " المستحقون " 2 – رسالة نسخ التذييل المطلوب 3 – رسالة نسخ الصفوف من 8 : 28 4 – رسالة طباعة الكشوف هذا وبالله التوفيق جزاكم الله خيرا وبارك فيكم جميعا وتقبل الله تعالى منا ومنكم صالح الاعمال ترحيل بيانات السادة العاملين بدلالة الرقم القومى - سعيد بيرم.rar

كل عام انتم جميعا بكامل الصحة والعافيه

اللهــــم يا حنَّان يا منَّان يا واسع الغفران اغفر له و ارحمه و عافه و اعف عنه و أكرم نزله و وسع مدخله و اغسله بالماء و الثلج و البرد و نقِّه من الذنوب و الخطايا كما ينقَّى الثوب الأبيض من الدنس

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

السلام عليكم ورحمته الله وبركاته بداية جزاكم الله خيرا ومن تقدم الى تقدم ملاحظاتى 1- فى السابق لايمكنك الدخول على أى صفحة أى عضو إلا من خلال تسجيل الدخول للموقع الان يمكنك الدخول على صفحة العضو المراد الدخول عليه دون تسجيل دخول للموقع 2- بشأن مشاركات الاعضاء التى أستبدلت بعبارة " إيجاد المحتوى " من خلال الوقوف بمؤشر الماوس على إسم العضو ايضا تتم دون تسجيل دخول مع وجود خطأ نحوى فى كلمة " أكتب" بصيغة الآمر والصواب هو العضو فلان " كتب فى موضوع كذا " 3- بشأن رتبة الاعضاء يرجى ملاحظة تباين الالوان بين اسم العضو ورتبته مايتلائم مع الخلفية الظاهرة وخاصة اللون الازرق المتعلق بالسادة الزملاء أعضاء الشرف والسادة الزملاء الخبراء المعتمدون 4- مع تسجيل الخروج من خلال الموضوع الذى يتم تصفحة يتم تسجيل الخروج على ذات الموضوع وليس الصفحة الرئيسية للموقع كما بالسابق *** نرجو الافاده وأخيرا اتمنى لكم مزيدا من الازدهار والرقى **** وجزاكم الله خيرا