نجوم المشاركات

السلام عليكم ورحمة الله وبركاته كل الشكر لأخى الفاضل / شوقى ربيع على هذا الإبداع ولإثراء الموضوع وكما طلب أخى الحبيب / محمود الشريف كود لإنشاء الصفحات إن لم تكن موجودة مع بعض الإضافات الأخرى مثل الترحيل بنفس التنسيقات وعمل مسلسل فى الصفحات المرحل اليها Sub ragab() Dim cl As Range, sh As Worksheet Application.ScreenUpdating = False For Each sh In ThisWorkbook.Worksheets If Not sh.Name = "Sheet1" Then sh.Range("A2:L1000").ClearContents End If Next LR = Cells(Rows.Count, 1).End(xlUp).Row For Each cl In Range("L2:L" & LR) x = Trim(cl.Value) On Error Resume Next If Worksheets(x) Is Nothing Then Sheets.Add.Name = x Sheets(x).Move After:=Sheets(Sheets.Count) End If Sheets("sheet1").Range("A1:L1").Copy Sheets(x).Range("A1").PasteSpecial xlPasteValues Sheets(x).Range("A1").PasteSpecial xlPasteFormats cl.Offset(0, -11).Resize(1, 12).Copy Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial xlPasteValues Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial xlPasteFormats Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial xlPasteColumnWidths Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 3).End(xlUp).Row, 1) = Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 3).End(xlUp).Row, 1).Row - 1 Application.CutCopyMode = False Next MsgBox "تم الترحيل بنجاح الى صفحات منفصلة" Sheets("sheet1").Select Application.ScreenUpdating = False End Sub قاعدة بيانات اعدادى2.rar

ان كان الاوفيس عندك عربي او انجليزي غير Dim sh As Worksheet, ws As Worksheet: Set sh = Feuil1 الى Dim sh As Worksheet, ws As Worksheet: Set sh = Sheet1

السلام عليكم خذ هذا الكود يرحلك اسم المعلم حسب المدرسة مهما كان عددهم المهم هو ان تكون اسماء الشيتات بأسماء المدارس صحيحة فقط كما في ملفك يمكنا زيادت ما تشاء من مدارس Sub test() Dim sh As Worksheet, ws As Worksheet: Set sh = Feuil1 Dim lr As Long: lr = sh.Cells(sh.Rows.Count, "C").End(xlUp).Row Dim i As Integer For i = 2 To lr Dim NomScol As String: NomScol = sh.Range("L" & i) For Each ws In Worksheets Dim NomWs As String: NomWs = ws.Name If NomWs = NomScol Then Set ws = Sheets(NomWs) Dim lrw As Long: lrw = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1 Dim r As Integer For r = 1 To 14 ws.Cells(lrw, r) = sh.Cells(i, r + 2) Next End If Next ws Next End Sub تحياتي

السلام عليكم وبعد إذن أخى الحبيب / أبو سما أخى الفاضل / محمد ما رأيك فى هذا الكود بدلا من الكود الموجود بالملف حيث يقوم الكود التالى بالترحيل حتى ولو لم تكن الصفحات التى سوف يرحيل إليها موجود فى البداية كما أنه يرحل البيانات بنفس التنسيقات وعمل مسلسل فى الصفحات التى سوف يرحل إليها Sub ragab() Dim cl As Range, sh As Worksheet Application.ScreenUpdating = False For Each sh In ThisWorkbook.Worksheets If Not sh.Name = "Sheet1" Then sh.Range("A2:L1000").ClearContents End If Next LR = Cells(Rows.Count, 1).End(xlUp).Row For Each cl In Range("L2:L" & LR) x = Trim(cl.Value) On Error Resume Next If Worksheets(x) Is Nothing Then Sheets.Add.Name = x Sheets(x).Move After:=Sheets(Sheets.Count) End If Sheets("sheet1").Range("A1:L1").Copy Sheets(x).Range("A1").PasteSpecial xlPasteValues Sheets(x).Range("A1").PasteSpecial xlPasteFormats cl.Offset(0, -11).Resize(1, 12).Copy Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial xlPasteValues Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial xlPasteFormats Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial xlPasteColumnWidths Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 3).End(xlUp).Row, 1) = Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 3).End(xlUp).Row, 1).Row - 1 Application.CutCopyMode = False Next MsgBox "تم الترحيل بنجاح الى صفحات منفصلة" Sheets("sheet1").Select Application.ScreenUpdating = False End Sub

أستخدم هذه المعادلة أخى ستحقق ماتريد ملاحظة تقوم بفصل حتى " 35 رقم " =SUMPRODUCT(MID(0&A2;LARGE(INDEX(ISNUMBER(--MID(A2;ROW($1:$35);1))*ROW($1:$35);0);ROW($1:$35))+1;1)*10^ROW($1:$35)/10) المعادلة يكفى فيها ( enter ) أى ليست معادلة صفيف تقبل تحياتى

السلام عليكم الموضوع (1) الدالة SUBSTITUTE كثيرا منا لم يسمع عنها وهى من دوال استبدال النصوص اى كان مكانها من الجملة ولها استخدامات اخرى انظر المرفق لاتحرمونا من ردودكم ودعائكم تحياتى دالة SUBSTITUTE.rar

السلام عليكم الاخ الكريم / عاصفة الصحراء بارك الله فيك شاهد المرفق التالي ... ان شاء الله به طلبك تقبل خالص تحياتي تحديد مصدر بيانات القائمة في الكومبوبكس بناءا علي الاختيار للـ Optionbotton.rar

أخى الحبيب / محمود الشريف جزاك الله كل خير على هذه الكلمات الطيبة

السلام عليكم الاخ الكريم / محمد عبد القادر بارك الله فيك وبعد اذن استاذي القدير / رجب جاويش ... جزاه الله خيرا (( اللي وحشنا كتييييييييييييير )) الذي رأيت رده بعد ان قمت بالتعديل علي الكود ... وارجو ان يعجبه ويفي بغرضك Sub tarheel() Application.ScreenUpdating = False Dim sh As Worksheet For Each sh In ThisWorkbook.Worksheets For r = 2 To 1000 If sh.Name = "sheet1" Then GoTo 2 If Cells(r, 1).Value <> Empty Then If Cells(r, 12).Value = sh.Name Then Range(Cells(r, 1), Cells(r, 12)).Copy QQ = sh.Cells(1000, 1).End(xlUp).Row + 1 sh.Range("A" & QQ).PasteSpecial xlPasteValues End If End If Next Next Application.DataEntryMode = False Application.ScreenUpdating = True 2 End Sub تقبلوا خالص تحياتي بيانات اعدادى1.rar

بين 2007 و 2010 لا توجد مشاكل إن شاء الله فإصدار 2010 قريب من 2007 المشكلة تظهر مع 2003 وإذا حدثت مشكلة فموقع شركة مايكروسوفت يوفر مجموعة من الادوات التي تتيح فتح ملفات مصممة على إصدارات حديثة داخل إصدارات قديمة وإليك رابط ملف التحويل http://www.microsoft.com/ar-sa/download/confirmation.aspx?id=3

حل اخونا عبدالرحمن 100% ولكن لا بد تضع المعيار في مكانه المناسب ، والمكان المناسب هو في الحقل (أو)

أخى فى الله الأستاذ القدير // شوقى ربيع بارك الله فيكم وزادكم الله من فضله ومن علمه ولى استفسار بسيط لو اردنا الترحيل بإنشاء شيتات جديدة واسم كل شيت يؤخذ أيضا حسب البيانات التى بالعمود ( L ) فكيف يكون الكود وتقبل منى وافر الاحترام والتقدير

أخى فى الله استاذى القدير // حماده عمر بارك الله فيكم وزادكم الله من فضله ومن علمه والشكر موصول للأستاذ الكبير / ابراهيم ابوليله أخى الكريم الأستاذ / عبد الغنى الملف المرفق من قبلكم بالمشاركه رقم 3 ليس به اى فورم وما قام به الأستاذ القدير // حماده عمر به فورم على ما اعتقد استوفى جميع ما طلبته فيتم الانتقال بين كل عملية سواء كانت الأولى او الثانية او الثالثة والترحيل أى ادخال البيانات بالأعمده الصفراء كما طلبت ولم أفهم تحديدا ما معنى 30 او 40 عملية فالنموذج المرفق سواء كان بالمشاركة الأولى أو الثالثة ليس به ما يفيد هذا العدد من العمليات أم أنكم تقصد ادخال حوالى 30 او 40 بيان فى العملية الواحده فيرجى منكم مزيد من التوضيح وتقبل منى وافر الاحترام والتقدير

أخى الكريم يمكن عمل ذلك عن طريق اما : 1 - عن طريق خدمه مايكروسوفت سكاى درايف للإشتراك فيها عن طريق ايميل علي الهوتميل 2 - عن طريق خدمة جوجل درايف للإشتراك فيها شاهد الفيديو التالى وتقبل منى وافر الاحترام والتقدير

السلام عليكم هته الفكرة راودتني عندما كنت اصمم برنامج دليل الهاتف على طريقة سامسونج جالكسي لكني لم أنجح حينها في تنفيذها اليوم وصلت الى الطريقة بحمد الله وشكره واردت مشاركتكم بها المهم وصلت الى طريقة تجعل اللون الابيض يختفي من الفورم حيث يصبح شفافا بل منعدم وبهذه الطريقة اصبح يمكن جعل الفورم ياخذ اي شكل نريده كل ما عليك هو وضع هذا الكود في موديل Option Explicit Public Declare Function FWw Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function SWLg Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function DrMBar Lib "user32" Alias "DrawMenuBar" (ByVal hWnd As Long) As Long Public Declare Function SLWA Lib "user32" Alias "SetLayeredWindowAttributes" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, ByVal dwFlags As Long) As Long Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Declare Function ReleaseCapture Lib "user32" () As Long Public hWnd As Long Public Function Rabie_Sk(uf As Object, colors As Variant, Optional Sk As Variant = True) hWnd = FWw(vbNullString, uf.Caption) SWLg hWnd, -16, &H80080080: SWLg hWnd, -20, &H80000: DrMBar hWnd Select Case Sk Case True SLWA hWnd, colors, &H2, &H1 Case False SLWA hWnd, colors, 50, &H2 End Select End Function وفي حدث UserForm_Initialize ضع هذ الكود Rabie_Sk Me, vbWhite, True والباقي عليك في اختيار الشكل الذي تريده لا اطيل عليكم وأترككم مع المرفق تحياتي للجميع اجعل الفورم يأخذ اي شكل تريده.rar

للمساعدة ادخل على الرابط مدونة برامج جاهزة

برنامج في قمة الروعة

السلام عليكم إخواني وأحبائي وجدت علي موقع أجنبي قائمة للمبتدئين في تعليمات وبرمجيات الفيجوال بيزيك للاكسل القائمة علي شكل فهرس ولم أفعل غير تنسيقها فقط بالإكسل تفضلوا القائمة بصيغتي 2003 ، 2007 عسي الله أن ينفع بهما Excel VBA Index.rar

السلام عليكم اخي الكريم هنا محاولة قد تلبي طلبك والله اعلم ظهور الصوره بالنسبه.rar

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

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