ياسر خليل أبو البراء قام بنشر مارس 14, 2015 قام بنشر مارس 14, 2015 السلام عليكم ورحمة الله وبركاته إخواني الكرام .. ومع كل جديد ومفيد ، أقدم لكم اليوم كود في منتهى الروعة ، يقوم الكود بإنشاء مصنف منفصل لكل ورقة عمل في نفس مسار الملف .. في الملف المرفق ، تم وضع المصنف المسمى Split Workbook في مجلد .. المصنف يحتوي على 4 أوراق عمل ( الأول Main - الثاني Data - الثالث Search - الرابع Result) في ورقة العمل المسماة Main يوجد زر أمر ، بالنقر عليه يتم عمل الكود ، ويبدأ في نسخ كل ورقة عمل ويسميها باسمها كمصنف جديد في نفس مسار المصنف الحالي ، ثم يقوم الكود بإغلاقه .. أسطر الكود مشروحة داخل الكود .. Sub SplitWorkbook() 'تعريف المتغير من النوع النصي Dim xPath As String 'تعريف المتغير من النوع ورقة عمل Dim SH As Worksheet 'تعيين المتغير لتساوي قيمته مسار المصنف الحالي xPath = Application.ActiveWorkbook.Path 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'إلغاء خاصية رسائل التنبيه Application.DisplayAlerts = False 'حلقة تكرارية لكل أوراق العمل بالمصنف For Each SH In ThisWorkbook.Sheets 'نسخ ورقة العمل SH.Copy 'حفظ ورقة العمل بنفس الاسم ونفس المسار Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & SH.Name & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled 'إغلاق المصنف الجديد والذي أصبح هو المصنف النشط Application.ActiveWorkbook.Close False 'الانتقال لورقة العمل التالية Next 'تفعيل خاصية رسائل التنبيه Application.DisplayAlerts = True 'تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub * ملحوظة : يجب ألا تكون هناك ورقة عمل بنفس اسم المصنف Split Workbook ، حتى لا يحدث مشكلة أثناء تنفيذ الكود أو لتجنب هذه المشكلة يمكن إضافة هذا السطر On Error Resume Next أرجو أن ينال الملف رضاكم ، وتستفيدوا منه في المقام الأول ... دمتم في رعاية الله وطاعته .. وهذا رابط لقناتي على اليوتيوب (في انتظار آرائكم حول القناة كبداية لمرحلة جديدة ..) My Channel أخوكم أبو البراء من منتدى أوفيسنا حمل الملف من هنا 13 1
ابو القبطان قام بنشر مارس 14, 2015 قام بنشر مارس 14, 2015 حبيبنا الغالي : ياسر خليل وددت اهنأك على قناتك الجديده ( ياترى دي من نتاج المؤتمر الاقتصادي ؟؟ ) بس فكرة الملف في منتهى الروعة تقبل تحياتي 1
عبدالله باقشير قام بنشر مارس 14, 2015 قام بنشر مارس 14, 2015 السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري 2
عادل ابوزيد قام بنشر مارس 14, 2015 قام بنشر مارس 14, 2015 الاستاذ ياسر ابداع ورا ابداع ما شاء الله عليك زادك الله من علمه وفضله واحسانه
ياسر خليل أبو البراء قام بنشر مارس 14, 2015 الكاتب قام بنشر مارس 14, 2015 الأخ الغالي أبو القبطان .. مكشور على مرورك الكريم مقلتش رأيك في القناة ؟ دي ولا القناة الأولى بتاعت زمان الأخ والحبيب والأستاذ عبد الله مشكور على مرورك العطر ، وجزيت خيراً بمثله
ياسر خليل أبو البراء قام بنشر مارس 14, 2015 الكاتب قام بنشر مارس 14, 2015 الأخ الغالي عادل أبو زيد مشكور على إطرائك الجميل .. بارك الله فيك وزادك من علمه ... وفي انتظار مساهماتك الفعالة
محمد طاهر عرفه قام بنشر مارس 15, 2015 قام بنشر مارس 15, 2015 السلام عليكم كود مقيد ، و فعال جزاكم الله خيرا لقت نظري أن الملف بالامتداد الذي به الماكرو مفعل ، و اعتقد اذا كان هناك اكواد على اوراق العمل ستنتقل معها ، و لكن اعتقد أن الموديول لن تنتقل ، فيما انك قد اخترت الامتداد xlsm فربما مستقبلا يمكن ان يضاف اليه نقل الموديول فى حالة وجوده أيضا اقترح اضافة الكود للمكتبة ، فهذه كانت فكرة قديمة لم تفعل و هي توثيق كل الاكواد المقيدة فى الكتبة فى فسم الاكسيل لسهولة الوصول اليها ، فتقترح اضافته للمكتبة اعلى الموقع و مبروك على القناة و ان شاء الله فاتحة خير 1
أبو إيمان قام بنشر مارس 15, 2015 قام بنشر مارس 15, 2015 جزاكم الله خيرا عاوزين بعد الانشطار اللي حصل دا نعمل اندماج وتأليف بين المصنفات المختلفة 1
الصـقر قام بنشر مارس 15, 2015 قام بنشر مارس 15, 2015 استاذى الحبيب ابوالبراء كنت منتظر خطوة القناه دى من فترة كبيرة والحمد لله ومشيئته تم ذالك الطريق طويل وفقك الله واعانك دقيقه من الفيديو توصل المعلومه افضل من شرح كتابى فى 100 صفحه بارك الله فيك وزادك علما ونفع بك وجعل اعمالك فى ميزان حسناتك (حته على جنب متنساش الاخ رفيع والاستاذ بتاع المزيكا هههههههههههههههههههههه دى كانت السبب فى بداية حلقات افتح الباب الحياه مش كلها جد لازم برضوا اى حاجه طريه ولا ايه؟ ) جزاكم الله اخيرا 1
ابراهيم الحداد قام بنشر مارس 15, 2015 قام بنشر مارس 15, 2015 (معدل) بارك الله فيك . بداية مبشرة وان شاء الله تكون تكون قناة رائعة تليق بروعة صاحبها فسر على بركة الله وننتظر منك المزيد تم تعديل مارس 15, 2015 بواسطه زيزو العجوز 1
ياسر خليل أبو البراء قام بنشر مارس 15, 2015 الكاتب قام بنشر مارس 15, 2015 (معدل) بسم الله ما شاء الله .. الانشطار عمل تفاعل كبير كدا ...أنا ممتن لكم إخواني الكرام مروركم العطر وتشجيعكم المستمر لي . الأخ الحبيب والأستاذ الكبير ، القلب النابض في المنتدى أستاذي محمد طاهر ..لكم يسعدني ويشرفني ردك على موضوعي .. بالنسبة للمكتبة الخاصة بالموقع .قمت من فترة بعمل موضوع في هذا الخصوص ، ولا أدري إذا كنت قد اطلعت عليه أم لا (المشروع الكبير ...مكتبة الصرح ...يمكن أن تجد رابط لها في توقيعي) المكتبة غير مفعلة من فترة ، ولكن أنتوي إكمالها بإذن الله خصوصاً أننا قطعنا شوطاً كبيراً فيها .. وهمتك معانا بردو ، في انتظار آرائكم واقتراحاتكم .. الأخ الغالي دغيدي .. بارك الله فيك وجزيت خيراً على مرورك العطر الأخ الحبيب أبو إيمان .. أنا أعمل إنشطار قوم إنت حالاً واعمل اندماج (أنا أفركش وإنت جمع اللي أنا فركشته ..كل واحد يعمل حاجة) الأخ الحبيب زيزو العجوز ..مشكور على مرورك العطر ، وإن شاء الله بعون الله هناك المزيد وكل يوم جديد وكله بحول الله مفيد الأخ اللي مش فاكر اسمه ..الأخ الحبيب حسام عيسى (فينك غطساااااان بقالك فترة .. لا صباح ولا مسا ولا كلمة كويسة ) مشكور على مرورك العطر ، وبارك الله فيك بس بالنسبة للقناة ..الفيديوهات ليها ناسها .. صراحة أنا غير متمكن فيها ..ومعرفش أقول في الفيديو اللي بقوله في الكتابة .. وبعدين موضوع تسجيل الفيديو بيغلبني لأن حجم الفيديو رغم إنه بيكون قليل في زمنه ، لكن حجمه بيكون خيالي .. لو عندك فكرة عن أفضل برنامج ليعطي أفضل جودة مع أقل حجم أكون ليك مشكور وممتن تحياتي القلبية لكم جميعاً إخواني في الله تم تعديل مارس 15, 2015 بواسطه YasserKhalil
أبو إيمان قام بنشر مارس 15, 2015 قام بنشر مارس 15, 2015 بسم الله ما شاء الله .. الأخ الحبيب أبو إيمان .. أنا أعمل إنشطار قوم إنت حالاً واعمل اندماج (أنا أفركش وإنت جمع اللي أنا فركشته ..كل واحد يعمل حاجة) أستاذنا الفاضل بيقولوا في الأمثال اللي حضر عفريت يصرفه وحضرتك اللي عملت الانشطار " حضرت العفريت " يبقى حضرتك تعمل لنا الاندماج "تصرف العفريت " وصباح الصباح واللي جاي أحسن من اللي راح 1
عاطف عبد العليم محمد قام بنشر مارس 15, 2015 قام بنشر مارس 15, 2015 السلام عليكم ورحمة الله وبركاته جزاكم الله خيرا كيف يمكن الاستفادة من هذا الانشطار ؟ مثلا لدي ملف فيه صفحة قيود يومية وصفحات ترحيل كثيرة هل يمكن أن يقسم لملفين فقط أو ثلاث وعند الترحيل يتم الترحيل للملفات كلها من ماكرو موجود في ملف القيود ثم بعد نهاية العام يتم ضم الصفحات مرة اخرى للملف الرئيسي ؟
ياسر خليل أبو البراء قام بنشر مارس 15, 2015 الكاتب قام بنشر مارس 15, 2015 الأخ أبو إيمان هو أنا بس اللي هتعامل مع العفريت ... مفيش مساعدة من إخواني .. العفريت محتاج كذا واحد عشان أقدر أصرفه (أصلي أول مرة أتعامل مع عفاريت) الأخ عاطف .. لا أحبذ تقسيم الملف إذا كانت أوراق العمل متداخلة ، مما قد ينتج عنه أخطاء كثيرة ، وقد لا يكون ذلك مضموناً ..خليك في المضمون .. أما بالنسبة إنك تتعامل مع أثر من مصنف ، فهناك أكواد تقوم بهذا الغرض ، ولكن يجب الحيطة في التعامل مع هذا النوع من الأكواد ..
محمد طاهر عرفه قام بنشر مارس 15, 2015 قام بنشر مارس 15, 2015 السلام عليكم أخي ياسر هذا هو القسم الذي أقصده http://www.officena.net/ib/index.php?app=downloads&showcat=16
ياسر خليل أبو البراء قام بنشر مارس 15, 2015 الكاتب قام بنشر مارس 15, 2015 أخي الحبيب محمد طاهر .. رغم وجودي بالمنتدى منذ فترة طويلة .. هذه أول مرة أطلع على هذا القسم عموماً ما أطمح إليه هو ملف كبير وضخم يضم أكواد من هنا وهناك ..كالذي على هذا الرابط http://www.officena.net/ib/index.php?showtopic=57935&hl= قم بالإطلاع على آخر المشاركات ..لترى آخر إصدار من مكتبة الصرح ، وفي انتظار ابداء رأيك بشأن هذه المكتبة ..
شوقي ربيع قام بنشر مارس 15, 2015 قام بنشر مارس 15, 2015 السلام عليكم اخي ياسر جزاك الله خيرا على هذا الكود الف مبروك القنات وان شاء الله تكون منبر من منابر تعلم الاكسل الأخ أبو إيمان هو أنا بس اللي هتعامل مع العفريت ... مفيش مساعدة من إخواني .. العفريت محتاج كذا واحد عشان أقدر أصرفه (أصلي أول مرة أتعامل مع عفاريت) متخفش اخوك شوقي موجود جنبك يصرف معاك 1000 عفريت هذه محاولة مني كبداية لجمع اول شيت من عدت ملفات اكسل من اي مجلد من على الجهاز في ملف اكسل واحد بحيث تكون اسماء الشيتات على اسماء تلك الملفات المجمعة الاندماج بعد الانشطار الكود مقسم الى قسمين القسم الاول يقوم بفتح نافذة لاختيار مجلد من الجهاز Function ChoixDossier() If Val(Application.Version) >= 10 Then With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = ActiveWorkbook.Path & "\" .Show If .SelectedItems.Count > 0 Then ChoixDossier = .SelectedItems(1) Else ChoixDossier = "" End If End With Else ChoixDossier = InputBox("Répertoire?") End If End Function القسم الثاني وهو قسم الدمج فكرته بسيطة وهي عبارة عن حلقة دوارانية تبحث في المجلد المختار عن ملفات الاكسل ثم تفتح الملفات واحد تلو الاخر مع نسخ محتوى الشيت الاول لكل ملف ثم لصق ما تم نسخه في شيت جديد في الملف الرئيسي مع اعطاء اسم الملف الى ذلك الشيت الجديد هذا كل ما في الامر Sub Affiche() Dim wb1 As Workbook, wb2 As Workbook Dim sPaNam As String Set wb1 = ActiveWorkbook Application.ScreenUpdating = False Application.DisplayAlerts = False For Each F In dossier.Files If UCase(Right(F.Name, 4)) = "XLSM" Then If UCase(Left(F.Name, 2)) <> "~$" And F.Name <> ThisWorkbook.Name Then sPaNam = xPath & "\" & F.Name Dim bT As Byte: bT = InStr(F.Name, ".xlsm") - 1 Dim sName As String: sName = Left(F.Name, bT) Set wb2 = Workbooks.Open(sPaNam) wb2.Sheets(1).Copy Before:=wb1.Sheets(1) ActiveSheet.Name = sName wb2.Close SaveChanges:=False Set wb2 = Nothing End If: End If Next Set wb1 = Nothing Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub اما هذا الكود Sub Agrégation() xPath = ChoixDossier() If xPath = "" Then Exit Sub Set Fs = CreateObject("Scripting.FileSystemObject") Set dossier = Fs.getfolder(xPath) Affiche End Sub يقوم باستدعاء الكودين الاولين حيث في الاول نمسك بمسار المجلد المختار ثم قمنا بتعريف المتغير Fs على انه ملف اما المتغير dossier تم تعريفه على انه مجلد تحياتي للجميع الملف الرئيسي الذي يحوي الاكواد هو الملف المسمى ب compilation de fichier Plusieurs fichiers en une seule compilation de fichier.rar
ياسر خليل أبو البراء قام بنشر مارس 15, 2015 الكاتب قام بنشر مارس 15, 2015 الأخ الحبيب شوقي ربيع بارك الله فيك وجزاك الله كل خير على المساندة الكبيرة .. لم أرى مشاركتك إلا الآن .. بصراحة من بدري وأنا مشغول مع العفريت ، وعملت موضوع جديد على هذا الرابط قبل أن أرى مشاركتك http://www.officena.net/ib/index.php?showtopic=59815 بس مش مشكلة زيادة الخير خيرين .. خلي العفاريت يرتاحوا من التنطيط 1
جلال الجمال_ابو أدهم قام بنشر مارس 16, 2015 قام بنشر مارس 16, 2015 اخى / ياسر بارك الله فيك مفرقعاتك قمه فى المعرفهتحياتى يا نوبل 1
عاطف عبد العليم محمد قام بنشر مارس 16, 2015 قام بنشر مارس 16, 2015 الأخ أبو إيمان هو أنا بس اللي هتعامل مع العفريت ... مفيش مساعدة من إخواني .. العفريت محتاج كذا واحد عشان أقدر أصرفه (أصلي أول مرة أتعامل مع عفاريت) الأخ عاطف .. لا أحبذ تقسيم الملف إذا كانت أوراق العمل متداخلة ، مما قد ينتج عنه أخطاء كثيرة ، وقد لا يكون ذلك مضموناً ..خليك في المضمون .. أما بالنسبة إنك تتعامل مع أثر من مصنف ، فهناك أكواد تقوم بهذا الغرض ، ولكن يجب الحيطة في التعامل مع هذا النوع من الأكواد .. جزاك الله خيرا اخي ياسر وفقكم الله 1
احمد حبيبه قام بنشر مارس 20, 2016 قام بنشر مارس 20, 2016 بصراحة ملف رائع ...جزاك الله خيرا لكن استاذى الفاضل ... هل يمكن تعديل الكود او اضافة اختيار لعمل انشطار لصفحة واحدة فقط ... ولتكن الصفحة النشطة جزاك الله عنا خيرا
ياسر خليل أبو البراء قام بنشر مارس 21, 2016 الكاتب قام بنشر مارس 21, 2016 أخي الكريم أحمد حبيبة جرب الكود التالي ..يمكنك تغيير اسم ورقة العمل في السطر المشار إليه في التعليق Sub SplitSpecificSheet() Dim xPath As String Dim SH As Worksheet xPath = Application.ActiveWorkbook.Path Set SH = Sheets("Data") 'غير اسم ورقة العمل المراد تصديرها Application.ScreenUpdating = False Application.DisplayAlerts = False With SH .Copy Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & .Name & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.ActiveWorkbook.Close False End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub تقبل تحياتي
الردود الموصى بها