عاطف عبد العليم محمد قام بنشر مايو 26, 2013 مشاركة قام بنشر مايو 26, 2013 السلام عليكم الكود التالي للترحيل يعمل بالطريقة المطلوبة وأريده ان يتكرر لعمل اكثر من كشف حساب وقد حاولت ولكن المحاولات لا تأتي بالنتيجة الصحيحة أرجو أن أكون قد أوضحت المطلوب والشكر مقدما لكل الأخوة في هذا المنتدى وخاصة لمن سيكتب الحل وفق الله الجميع لما يحب ويرضى التكرار سيكون لعدد = d رقم الحساب المطلوب الكشف له وهو هنا p كان في الخلية m204 والحساب التالي سيكون في الخلية v204 والذي بعده سيكون في ae204 وهكذا أي بعد 9 أعمدة من الذي قبله وكذلك الترحيل للحساب التالي بعد 9 أعمدة من أول خلية تم الترحيل لها في الحساب السابق فمثلا الصف الأول كان m208 وn208 إلى s208 اما الحساب الجديد فسيكون الصف الأول لبداية الترحيل يبدء من v208 Application.ScreenUpdating = False Sheets("الرواتب").Select Dim d, a, b, s, p, k, m, c, e As Integer d = Range("f7", Range("f7").End(xlDown)).Count a = 13 b = 19 For i = 1 To d Range(Cells(208, a), Cells(450, b)).ClearContents a = a + 9 b = b + 9 Next i dat1 = Sheets("الرواتب").Range("e1").Value ' شهر البداية dat2 = Sheets("الرواتب").Range("e2").Value ' شهر النهاية rng1 = Sheets("قيوداليومية").Range("m11").Value 'عدد الادخالات موجودة في هذه الخانة s = 208 p = 13 'x = Sheets("الرواتب").Range("m204").Value ' رقم الحساب المطلوب الكشف له x = Cells(204, p).Value ' رقم الحساب المطلوب الكشف له For i = 6 To rng1 + 6 ' ستة لأن البيانات في قيود اليومية من السطر السادس x1 = Sheets("قيوداليومية").Cells(i, 3).Value date9 = Sheets("قيوداليومية").Cells(i, 5).Value ' تاريخ الحساب المتواجد في جدول القيود If x <> x1 Then GoTo out1 If dat1 > date9 Then GoTo out1 ' اذا التاريخ أكبر من التاريخ الأعلى لا تنفذ If dat2 < date9 Then GoTo out1 ' اذا التاريخ أصغر من التاريخ الأدنى لا تنفذ e = 4 c = 13 For m = 1 To 7 Sheets("الرواتب").Cells(s, c).Value = Sheets("قيوداليومية").Cells(i, e).Value e = e + 1 c = c + 1 Next m s = s + 1 out1: Next i Application.ScreenUpdating = True End Sub رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر مايو 26, 2013 مشاركة قام بنشر مايو 26, 2013 السلام عليكم أخي الكريم ، يصعب هذا بدون الملف المرفق حاول مع الكود التالي ، إن لم ينجح لابد من إرسال الملف Application.ScreenUpdating = False Sheets("الرواتب").Select Dim d, a, b, s, p, k, m, c, e As Integer d = Range("f7", Range("f7").End(xlDown)).Count For T = 1 To d a = 13: b = 19 For i = 1 To d Range(Cells(208, a), Cells(450, b)).ClearContents a = a + 9 b = b + 9 Next i dat1 = Sheets("الرواتب").Range("e1").Value ' شهر البداية dat2 = Sheets("الرواتب").Range("e2").Value ' شهر النهاية rng1 = Sheets("قيوداليومية").Range("m11").Value 'عدد الادخالات موجودة في هذه الخانة s = 208: p = 13 'x = Sheets("الرواتب").Range("m204").Value ' رقم الحساب المطلوب الكشف له x = Cells(204, p).Value ' رقم الحساب المطلوب الكشف له For i = 6 To rng1 + 6 ' ستة لأن البيانات في قيود اليومية من السطر السادس x1 = Sheets("قيوداليومية").Cells(i, 3).Value date9 = Sheets("قيوداليومية").Cells(i, 5).Value ' تاريخ الحساب المتواجد في جدول القيود If x <> x1 Then GoTo out1 If dat1 > date9 Then GoTo out1 ' اذا التاريخ أكبر من التاريخ الأعلى لا تنفذ If dat2 < date9 Then GoTo out1 ' اذا التاريخ أصغر من التاريخ الأدنى لا تنفذ e = 4: c = 13 For m = 1 To 7 Sheets("الرواتب").Cells(s, c).Value = Sheets("قيوداليومية").Cells(i, e).Value e = e + 1: c = c + 1 Next m s = s + 1 out1: Next i Next T Application.ScreenUpdating = True End Sub رابط هذا التعليق شارك More sharing options...
عاطف عبد العليم محمد قام بنشر مايو 26, 2013 الكاتب مشاركة قام بنشر مايو 26, 2013 السلام عليكم أخي الكريم ، يصعب هذا بدون الملف المرفق حاول مع الكود التالي ، إن لم ينجح لابد من إرسال الملف وعليكم السلام والرحمة والإكرام للأسف واضح ان الكود لن يعمل بالطريقة الصحيحة انا طلبت التعديل في الترحيل وهو الجزء الثاني من الكود والجزء الأول مسح المحتويات لا تعديل فيه وبكود حضرتك سيتم مسح الترحيل لكل مرة يرحل فيها هذا اولا ثانيا وهو الأهم x = Cells(204, p).Value ' رقم الحساب المطلوب الكشف له لم يتغير نتيجة الكود المطلوبة هو عمل كشف للحساب ( ا) ثم عمل كشف بجواره للحساب ( ب) وهكذا لعدد من الحسابات قد لا يكون التصور واضح ولكن الملف كبير ولعلي إن شاء الله أعمل ملف فقط به الجزء المطلوب وأرفعه شكرا لك وجزاك الله خيرا رابط هذا التعليق شارك More sharing options...
عاطف عبد العليم محمد قام بنشر مايو 26, 2013 الكاتب مشاركة قام بنشر مايو 26, 2013 أخي طارق السلام عليكم الملف مرفق وجزاكم الله خيرا وبعد التعديل من قبلكم لي مطلب آخر لو تكرمتم ترحيل لأكثر من حساب .rar رابط هذا التعليق شارك More sharing options...
عاطف عبد العليم محمد قام بنشر مايو 27, 2013 الكاتب مشاركة قام بنشر مايو 27, 2013 هل من مساعد ؟ رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر مايو 27, 2013 مشاركة قام بنشر مايو 27, 2013 السلام عليكم تفضل أخي هذا الكود وقد جربته بلامشاكل Public Sub الرواتب() ' الرواتب ماكرو ' لعمل كشوف حساب الرواتب Application.ScreenUpdating = False Sheets("الرواتب").Select d = Range("f7", Range("f7").End(xlDown)).Count a = 13: b = 19 'رقم 13 تمثل العمود m , رقم 19 تمثل العمود s For i = 1 To d Range(Cells(208, a), Cells(450, b)).ClearContents a = a + 9 b = b + 9 Next i Dim s, p, k As Integer dat1 = Sheets("الرواتب").Range("e1").Value ' شهر البداية dat2 = Sheets("الرواتب").Range("e2").Value ' شهر النهاية rng1 = Sheets("قيوداليومية").Range("m11").Value 'عدد الادخالات موجودة في هذه الخانة For p = 13 To 40 Step 9 s = 208 x = Cells(204, p).Value ' رقم الحساب المطلوب الكشف له For i = 6 To rng1 + 6 ' ستة لأن البيانات في قيود اليومية من السطر السادس x1 = Sheets("قيوداليومية").Cells(i, 3).Value date9 = Sheets("قيوداليومية").Cells(i, 5).Value ' تاريخ الحساب المتواجد في جدول القيود If x <> x1 Or dat1 > date9 Or dat2 < date9 Then GoTo out1 'اذا الحساب ليس هو أو التاريخ ليس بين التاريخ الأدنى والأعلي فلا تنفذ Dim m, c, e As Integer e = 4 c = p For m = 1 To 7 Cells(s, c).Value = Sheets("قيوداليومية").Cells(i, e).Value e = e + 1 c = c + 1 Next m s = s + 1 out1: Next i Next p Application.ScreenUpdating = True End Sub ومرفق الملف أيضا وبه الكود المعدل ترحيل لأكثر من حساب2.rar رابط هذا التعليق شارك More sharing options...
عاطف عبد العليم محمد قام بنشر مايو 27, 2013 الكاتب مشاركة قام بنشر مايو 27, 2013 الحمد لله و جزاك الله خيرا الجملة التي تفضلت بها هي For p = 13 To 40 Step 9 واسمح لي أن تكون كالآتي لتكون عامة بدون تحديد عدد الحسابات For p = 13 To d * 9 Step 9 وهي تعمل بدون مشاكل والحمد لله سؤال آخر لو تكرمتم هل اطمع منكم في جعل الكود يشمل عدة صفحات بدلا من صفحة الرواتب فقط سنفترض ان الصفحات هي صفحة الرواتب وصفحة العملاء وصفحة البنوك وهكذا فأريده أن ينفذ الكود على صفحة الرواتب ثم صفحة العملاء ثم صفحة البنوك و قد قرأت حلول لذلك من فترة فلعلك تذكرني بها ، وفقكم الله رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر مايو 27, 2013 مشاركة قام بنشر مايو 27, 2013 نعم أخي يمكن لك ولكني سأحتاج الملف كاملا لأعمل عليه عموما ستكون نفس فكرة الحلقات For Next سنضع للكود حلقة أكبر تحتويه تتحرك بالورقة ثم تعيد الكود بالكامل للورقات واحدة تلو الأخري رابط هذا التعليق شارك More sharing options...
عاطف عبد العليم محمد قام بنشر مايو 27, 2013 الكاتب مشاركة قام بنشر مايو 27, 2013 السلام عليكم اسمح لي بطلب مع الطلب السابق وهو في بداية تنفيذ الماكرو تظهر رسالة اختيار للمستخدم ( الترحيل للصفحة الحالية فقط أو الترحيل لكل الصفحات ) الصفحات في المثال الرواتب ـ العملاء ـ البنوك ـ السيارات ( ويمكن أن تزيد ) وتوجد صفحات مثل صفحة الدليل لا ينفذ عليها الماكرو واتصور ان في بداية الماكرو سيتم تحديد الصفحات و سيتم الغاء كلمة Sheets("الرواتب") في مقابل مايفيد بالصفحة الحالية جزاك الله خيرا وغفر الله لوالدينا ووالديكم ولجميع المسلمين ترحيل لأكثر من حساب .rar رابط هذا التعليق شارك More sharing options...
أفضل إجابة طارق محمود قام بنشر مايو 27, 2013 أفضل إجابة مشاركة قام بنشر مايو 27, 2013 السلام عليكم أخي العزيز أضفت بعض البيانات الوهمية في صفحة قيوداليومية (لونتها بالأصفر) للتأكد من الأكواد وأضفت لك فورم صغير يتيح لك إختيار بعض الورقات أو الكل تفضل الملف وبه المطلوب ترحيل لأكثر من حساب2.zip رابط هذا التعليق شارك More sharing options...
عاطف عبد العليم محمد قام بنشر مايو 27, 2013 الكاتب مشاركة قام بنشر مايو 27, 2013 وعليكم السلام ورحمة الله وبركاته اخي طارق محمود ما شاء الله تبارك الله لا قوة إلا بالله رائع ياسيدي وسأنقل الكود والفورم للملف الأصلي وآمل أن يعمل بإذن الله و بقي شرح أكواد الفورم ولأني لا أعرف فيها شيء فلا أريد أن اثقل عليك بطلب شرحها ولعلي أحاول فهمها لاحقا طلب آخر وأعرف إني اثقلت عليك ولكن عذرا و أرجو أن يتسع وقتك وصبرك للرد عليه أريد فورم لإدخال القيود وللبحث فيها هل ترى أن أذكر الطلب في موضوع مستقل أو ياسيدي هل ترى أن أذكر المطلوب ضمن هذا الموضوع ؟؟؟ بارك الله فيكم وجزاكم الله خيرا وأخيرا ما رأيك في الآتي مع إن علمي في الشعر مثل علمي في أكواد الفورمات أحب الصالحين وأسأل الله أن يجعلني منهم ** لعلي أن أنال بـهم شفـاعـة وأكره مَن تجارته المعاصي ** ولو كنا سواء في البضاعة رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر مايو 28, 2013 مشاركة قام بنشر مايو 28, 2013 السلام عليكم أخي الحبيب وسأنقل الكود والفورم للملف الأصلي وآمل أن يعمل بإذن الله و بقي شرح أكواد الفورم ولأني لا أعرف فيها شيء فلا أريد أن اثقل عليك بطلب شرحها ولعلي أحاول فهمها لاحقا إنقلها وستعمل بإذن الله تذكر أن التصدير ثم الإستيراد هما الأفضل لنقل الفورم Export - Import بالنسبة للشرح ، ستجد بكود الفورم بعض العبارات تساعد علي ذلك طلب آخر أريد >> فورم لإدخال القيود وللبحث فيها هل ترى أن أذكر الطلب في موضوع مستقل أو أن أذكر المطلوب ضمن هذا الموضوع ؟؟؟ سأحاول عندما يكون لدي وقت في هذا إن كنت تتعجل النتيجة فضعها في موضوع مستقل وأخيرا ما رأيك في ..... الشعر الواقع أني أحب الشعر جدا وهذان البيتان ﺃﺣﺐ ﺍﻟﺼﺎﻟﺤﻴﻦ ﻭﻟﺴﺖ ﻣﻨﻬﻢ :: ﻭﺃﺭﺟﻮ ﺃﻥ ﺃﻧﺎﻝ ﺑﻬﻢ ﺷﻔﺎﻋﺔ ﻭﺃﻛﺮﻩ ﻣﻦ ﺗﺠﺎﺭﺗﻪ ﺍﻟﻤﻌﺎﺻﻲ :: ﻭﺇﻥ ﻛﻨﺎ ﺳﻮﺍﺀ ﻓﻲ ﺍﻟﺒﻀﺎﻋﺔ هما في الحقيقة للإﻣﺎﻡ ﺍﻟﺸﺎﻓﻌﻲ ﺭﺣﻤﻪ ﺍﻟﻠﻪ وقد رد عليه الإﻣﺎﻡ ﺃﺣﻤﺪ ﺑﻦ ﺣﻨﺒﻞ ﺭﺣﻤﻪ ﺍﻟﻠﻪ قائلا :- ﺗﺤﺐ ﺍﻟﺼﺎﻟﺤﻴﻦ ﻭﺃﻧﺖ ﻣﻨﻬﻢ :: ﺭﻓﻴﻖ ﺍﻟﻘﻮﻡ ﻳﻠﺤﻖ ﺑﺎﻟﺠﻤﺎﻋﺔ ﻭﺗﻜﺮﻩ ﻣﻦ ﺑﻀﺎﻋﺘﻪ ﺍﻟﻤﻌﺎﺻﻲ :: ﺣﻤﺎﻙ ﺍﻟﻠﻪ ﻣﻦ ﺗﻠﻚ ﺍﻟﺒﻀﺎﻋﺔ رابط هذا التعليق شارك More sharing options...
عاطف عبد العليم محمد قام بنشر مايو 31, 2013 الكاتب مشاركة قام بنشر مايو 31, 2013 السلام عليكم ـ أخي طارق محمود هنيئا لكم حبكم للشعر وقد كان رسول الله محمد صلى الله عليه وسلم يحب ان يسمع الشعر http://www.ruowaa.com/vb3/showthread.php?t=1565 وهذا شعر عن رسول الله صلى الله عليه وسلم http://forum.hawahome.com/t103973.html أحب الصالحين ولست منهم ـ أول ما يتبادر للذهن لست منهم أي أنا من عكس الصالحين وهذا المعنى والله أعلم لا ينبغي قوله ـ نعم لا نزكي أنفسنا ولكن أيضا لا ينبغي أن نسب أنفسنا ولذلك قلت أحب الصالحين وأسأل الله أن يجعلني منهم ولما قلت أن هذه الابيات للإمام الشافعي يرحمه الله فلابد أنه على صواب وإني على خطأ ولذلك فكرت قليلا ـ تعلم ان اصحاب الجنة ونسأل الله أن يجعلني وإياك منهم هم قسمين اصحاب اليمين والمقربين فلعل الإمام الشافعي يقصد بكلامه المقربين ـ وتعلم انه يجوز للفرد ان يقول عن نفسه انه مسلم ولا يجوز ان يقول عن نفسه انه مؤمن { فَلا تُزَكُّوا أَنْفُسَكُمْ } ... الآية ( قَالَتِ الْأَعْرَابُ آمَنَّا قُل لَّمْ تُؤْمِنُوا وَلَكِن قُولُوا أَسْلَمْنَا وَلَمَّا يَدْخُلِ الْإِيمَانُ فِي قُلُوبِكُمْ .... ) الآية فلعله كان يقصد بالصالحين بالمؤمنين ــ المهم أنني أعترف بأنني على خطأ طالما أن القائل هو الإمام الشافعي نعود إلى الإكسيل أخي الفاضل قلتم سأحاول عندما يكون لدي وقت في هذا إن كنت تتعجل النتيجة فضعها في موضوع مستقل الحمد لله أنا لست مستعجل فالبرنامج يعمل ولكن ما أريده هو تحسين له ، ولأني لا أريد احراجكم فسوف اضعه في موضوع مستقل لاحقا إن شاء الله وإن شاء الله أجد من يتطوع للحل وإلا سأكتب مشاركة أخرى في هذا الموضوع لتقرأها إن شاء الله وتفيدني أفادك الله جزاكم الله خيرا ووفقكم الله لما يحب ويرضى رابط هذا التعليق شارك More sharing options...
عاطف عبد العليم محمد قام بنشر يونيو 1, 2013 الكاتب مشاركة قام بنشر يونيو 1, 2013 السلام عليكم ـ أخي طارق محمود السلام عليكم أخي الحبيب وسأنقل الكود والفورم للملف الأصلي وآمل أن يعمل بإذن الله و بقي شرح أكواد الفورم ولأني لا أعرف فيها شيء فلا أريد أن اثقل عليك بطلب شرحها ولعلي أحاول فهمها لاحقا إنقلها وستعمل بإذن الله تذكر أن التصدير ثم الإستيراد هما الأفضل لنقل الفورم Export - Import بالنسبة للشرح ، ستجد بكود الفورم بعض العبارات تساعد علي ذلك أخي الحبيب واجهتني مشكلة ان الترحيل يقف عند صفحة معينة ولا يكمل باقي الصفحات ـ جعلت هذه الصفحة الاخيرة هل لديك اقتراح للحل ام يجب رفع الملف للتشييك وفقكم الله رابط هذا التعليق شارك More sharing options...
عاطف عبد العليم محمد قام بنشر يونيو 1, 2013 الكاتب مشاركة قام بنشر يونيو 1, 2013 السلام عليكم أخي الحبيب قلت ان الترحيل يقف عند صفحة معينة وأظن ان الصواب انه يقف بعد عدد معين من الصفحات ـ سأتأكد و افيدكم لاحقا ان شاء الله وفقكم الله رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر يونيو 2, 2013 مشاركة قام بنشر يونيو 2, 2013 السلام عليكم أخي العزيز المشكلة في السطر التالي For p = 13 To 40 Step 9 أنظر في الشيت إلي أرقام الأعمدة المكتوب بالسطر 202 حيث العمود 13 هو M ستجد أن عندك حسابات حتي العمود 49 فقط غيره إلي For p = 13 To 49 Step 9 أو استبدله تماما بالتالي LstC = [iV204].End(xlToLeft).Column For p = 13 To LstC Step 9 رابط هذا التعليق شارك More sharing options...
عاطف عبد العليم محمد قام بنشر يونيو 2, 2013 الكاتب مشاركة قام بنشر يونيو 2, 2013 وعليكم السلام ورحمة الله وبركاته جزاكم الله خيرا على تفضلكم بالرد وعذرا اعتبرني تلميذ بليد يحتاج لمزيد من الشرح ـ فأنا أظن أن المشكلة ليست في عدد الحسابات التي ترحل بعد ان حددنا الآتي d = Range("f7", Range("f7").End(xlDown)).Count For p = 13 To ((d + 1) * 9) Step 9 فانا عندي صفحات بها أكثر من مائة حساب والترحيل يتم والحمد لله المشكلة في عدد الصفحات التي يتم الترحيل فيها وليس في عدد الحسابات التي ترحل اظن أخي ان المشكلة قد تكون في استخدام العمود d لإظهار الليست بوكس وكتابة اسماء الصفحات والتي ممكن أنه سيتم ترحيلها ( لو تم اختيارها ) Sheets(1).[D1:D99].ClearContents وقد يكون في الصفحة الأولى العمود d مايمنع من ذلك مثلا قد يكون في صف من الصفوف العمود d مدمج مع عمود آخر فضلا على انه قد يكون هناك بيانات مهمة وبهذا الكود Sheets(1).[D1:D99].ClearContents تمسح البيانات فما رأيك لو غيرنا العمود d الى آخر عمود في الصفحة xdf فلن يستخدم بأي حال ـ فيكون Sheets(1).[xDf1:xDf99].ClearContents فإذا كان ما قلته صواب فماذا أيضا يجب تغييره فالسطر السابق موجود في كود الترحيل كما انه موجود في كود الفورم فهل في كود الفورم مايلزم تغييره أيضا ؟ مثل ال d في هذا السطر (Sheets(1).Cells(i + 1, "D") = ListBox1.List(i شكرا لك سعة صدرك وتفضلك بالرد ، ووفقكم الله لما يحب ويرضى والسلام عليكم ورحمة الله وبركاته رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر يونيو 3, 2013 مشاركة قام بنشر يونيو 3, 2013 السلام عليكم اظن أخي ان المشكلة قد تكون في استخدام العمود d لإظهار الليست بوكس وكتابة اسماء الصفحات والتي ممكن أنه سيتم ترحيلها ( لو تم اختيارها ) Sheets(1).[D1:D99].ClearContents وقد يكون في الصفحة الأولى العمود d مايمنع من ذلك مثلا قد يكون في صف من الصفوف العمود d مدمج مع عمود آخر فضلا على انه قد يكون هناك بيانات مهمة وبهذا الكود Sheets(1).[D1:D99].ClearContents تمسح البيانات فما رأيك لو غيرنا العمود d الى آخر عمود في الصفحة xdf فلن يستخدم بأي حال ـ فيكون Sheets(1).[xDf1:xDf99].ClearContents فإذا كان ما قلته صواب فماذا أيضا يجب تغييره فالسطر السابق موجود في كود الترحيل كما انه موجود في كود الفورم فهل في كود الفورم مايلزم تغييره أيضا ؟ مثل ال d في هذا السطر (Sheets(1).Cells(i + 1, "D") = ListBox1.List(i أخي العزيز Sheets(1) هو ورقة "دليل الحسابات" وهذه لابها دمج ولاأي شيء بعد العمود الثالث فلاتقلق ولاداعي للتغيير فقط يمكنك تغيير الـ 99 بـ 999 إحيث أنك قلت " فانا عندي صفحات بها أكثر من مائة حساب والترحيل يتم والحمد لله" أو لنبحث عن سبب آخر رابط هذا التعليق شارك More sharing options...
عاطف عبد العليم محمد قام بنشر يونيو 9, 2013 الكاتب مشاركة قام بنشر يونيو 9, 2013 السلام عليكم أخي الكريم تفضلتم بالرد ولم انتبه لذلك ( كنت انتظر الرد وانت رددت بالفعل ) فعذرا الامر ملتبس علي فأرجو التوضيح مافهمته أن ما يكتب في العمود d هي اسماء الصفحات ؟ والآن حضرتك كتبت فقط يمكنك تغيير الـ 99 بـ 999 إحيث أنك قلت " فانا عندي صفحات بها أكثر من مائة حساب والترحيل يتم والحمد لله" هل معنى ذلك أنه يكتب فيها أيضا اسماء الحسابات ؟ والله أنا آسف لإشغالك والتمس لك العذر ـ ارجوك اخي الكريم ان تراجع كود الفورم ( عندما يتيسر لك ) / ها هو Private Sub UserForm_Activate() 'هنا بمجرد تفعيل الفورم يمسح محتوي الليستبوكس1 ثم 'يمر المؤشر علي ورقات الملف كلها وإذا كانت الخلية 'E1 'تحتوي تاريخا فيضيف تلك الورقة للفورم ، وإلا يتجاوزها Sheets(1).[D1:D99].ClearContents ListBox1.Clear For i = 1 To Sheets.Count If IsDate(Sheets(i).[E1]) Then ListBox1.AddItem Sheets(i).Name Next End Sub رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر يونيو 9, 2013 مشاركة قام بنشر يونيو 9, 2013 السلام عليكم أخي الكريم أولا الكود الذي ذكرته أنت يتم تفعيله مباشرة مع تفعيل الفورم وهو يمسح الخلايا D1:D99 في Sheets.1 ثم يمسح محتويات ListBox1 ثم يمر علي جميع الشيتات بلا استثناء إن كانت الخلية E1 تحوي رقما فيضيف إسم ذاك الشيت للـ ListBox1 ثم يوجد لديك أيضا الكود التالي والذي يتم تفعيله بالضغط علي Label1 الزر الأخضر (إختر الورقة / الورقات) Private Sub Label1_Click() 'On Error Resume Next For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) = True Then r = r + 1 Sheets(1).Cells(r, "D") = ListBox1.List(i) End If ListBox1.Selected(i) = False Next Me.Hide shift_all End Sub وهذا الكود عندما يتم تفعيله يدخل حلقة For - Next ليحدد (من محتويات HistBox1) ماالذي تم إختياره من عناصرها (التي هي أسماء شيتات) ويضعها بالترتيب بالعمود D بالشيت Sheets.1 ثم يخفي الفورم ويبدأ كود الترحيل shift_all والآن لنذهب لكود الترحيل الذي يعتمد في عمله علي محتويات العمود D في الورقة Sheets.1 Sub shift_all() Application.ScreenUpdating = False For rw = 1 To Sheets(1).[D99].End(xlUp).Row sh_nam = Sheets(1).Cells(rw, "D") Sheets(sh_nam).Select d = Range("f7", Range("f7").End(xlDown)).Count ... ... ... End Sub أول سطر كنت أفترض فيه أن عدد الشيتات لن يتجاوز 99 For rw = 1 To Sheets(1).[D99].End(xlUp).Row لذلك تجاوز عدد الشيتات التي ستختارها للترحيل رقم الـ 99 فستكون الخلية D99 بها بيانات نتيجة عمل كود Private Sub Label1_Click() الذي سبق شرحه وتكون نتيجة الأمر .[D99].End(xlUp).Row دائما 1 ، حيث يقف المؤشر علي الخلية D99 التي بها بيانات ويقفز للأعلي حيث يجد خليه ليس بها بيانات ، فلن يجد ويقف عند آخر خليه بالأعلي الخلية D1 ولن يرحل إلا شيت واحد فقط وكنت أقصد بــ "فقط يمكنك تغيير الـ 99 بـ 999 " أن تغير بالكود كل 99 إلي 999 أرجو أن يكون الأمر واضح ولاتتردد في أي سؤال رابط هذا التعليق شارك More sharing options...
عاطف عبد العليم محمد قام بنشر يونيو 11, 2013 الكاتب مشاركة قام بنشر يونيو 11, 2013 وعليكم السلام ورحمة الله وبركاته السلام عليكم أخي الكريم أول سطر كنت أفترض فيه أن عدد الشيتات لن يتجاوز 99 For rw = 1 To Sheets(1).[D99].End(xlUp).Row لذلك تجاوز عدد الشيتات التي ستختارها للترحيل رقم الـ 99 فستكون الخلية D99 بها بيانات نتيجة عمل كود Private Sub Label1_Click() الذي سبق شرحه وتكون نتيجة الأمر .[D99].End(xlUp).Row دائما 1 ، حيث يقف المؤشر علي الخلية D99 التي بها بيانات ويقفز للأعلي حيث يجد خليه ليس بها بيانات ، فلن يجد ويقف عند آخر خليه بالأعلي الخلية D1 ولن يرحل إلا شيت واحد فقط وكنت أقصد بــ "فقط يمكنك تغيير الـ 99 بـ 999 " أن تغير بالكود كل 99 إلي 999 أرجو أن يكون الأمر واضح ولاتتردد في أي سؤال يا سيدي بالفعل اتعبتك معي ـ وبالفعل عدد الشيتات لم يتجاوز 99 هم 28 فقط والترحيل يتم للغالبية العظمى من الشيتات استفدت من ردكم السابق شرح الأكواد الشكر الجزيل لك ويبدو انني لم أصل لتوصيف المشكلة بالطريقة الكافية التي تمكنكم من حلها لذلك فسأمنح نفسي الفرصة والوقت الكافي للتعرف على المشكلة لتحديدها بدقة من خلال اعادة الترحيل اكثر من مرة والتبديل بين اماكن الشيتات فإلى ذلك الحين لك ان تستريح من هذا الموضوع وفقكم الله وجزاكم الله خيرا وغفر الله لوالدينا ووالديكم ولجميع المسلمين ، والسلام عليكم ورحمة الله وبركاته رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر يونيو 11, 2013 مشاركة قام بنشر يونيو 11, 2013 جزاك الله خيرا وبارك لك رابط هذا التعليق شارك More sharing options...
عاطف عبد العليم محمد قام بنشر يونيو 15, 2013 الكاتب مشاركة قام بنشر يونيو 15, 2013 أخي الكريم طارق محمود السلام عليكم ورحمة الله وبركاته وجدتها السبب الذي بسببه لا يتم ترحيل بعض الصفحات هو أن الصفحة الأولى عندي كان بها صفوف مخفية ووجدت أنه إذا كانت الصفوف المخفية تشمل إلى نهاية الصفوف التي يسجل بها اسماء الصفحات فلا يتم ترحيل الصفحات المسجلة بالصفوف المخفية أما إذا كانت الصفوف المخفية تشمل بعض الصفوف المسجل بها اسماء الصفحات و آخر الصفوف غير مخفية فترحل الصفحات كلها وقد جربت ذلك على الملف المثال وقد وضعت في Private Sub UserForm_Activate() هذين السطرين Sheets(1).Rows("1:99").EntireRow.Hidden = False Sheets(1).[d1:d99].UnMerge فأصبح الماكرو كالآتي () Private Sub UserForm_Activate Sheets(1).Rows("1:99").EntireRow.Hidden = False Sheets(1).[d1:d99].UnMerge Sheets(1).[d1:d99].ClearContents ListBox1.Clear For i = 1 To Sheets.Count If IsDate(Sheets(i).[E1]) Then ListBox1.AddItem Sheets(i).Name Next End Sub وأظن أنه بذلك انتهت المشكلة أكرر اعتذاري لإشغالكم وتعبكم وأكرر شكري الجزيل لكم وفقكم الله وغفر الله لنا ولكم ولوالدينا ووالديكم ولجميكم المسلمين والسلام عليكم ورحمة الله وبركاته رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر يونيو 15, 2013 مشاركة قام بنشر يونيو 15, 2013 الحمد لله الذي بنعمته تتم الصالحات رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.