ياسر خليل أبو البراء

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

أبي الحبيب أبو يوسف بارك الله فيك ..شكلك فنان تشكيلي (تشكيلي غير تشكي لي .. !!) مجهود رائع وتنسيق جميل .. ولكن انتبه كثرة التنسيقات في الملف من شأنها أن تجعل الملف كبير الحجم وثقيل في التعامل ، فلا تكثر منها تقبل وافر حبي وتقديري

أخي الكريم لا تنسى أن تقوم بتغيير اسم الظهور للغة العربية إليك الكود التالي ليؤدي المطلوب إن شاء الله Sub DeleteEntireRow() Dim Cel As Range, I As Long For I = 35 To 9 Step -1 If IsDate(Cells(I, "E").Value) Then Cells(I, "E").EntireRow.Delete Next I End Sub تقبل تحياتي

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

أخي الكريم مهند الزيدي أعتقد أن الكود لي تقريباً والكود يعمل بشكل جيد المشكلة في المدخلات وليست في الكود ...حيث أنه في الخلية A10 يوجد البيان "مراقبة" وهو ليس ضمن الجدول الموجود في ورقة العمل أجور الطبيب جرب تغير كلمة مراقبة إلى كلمة "الكبرى" مثلاً ..ستجد أنه لا مشكلة في تنفيذ الكود .. أرجو أن يكون ذلك حل للمشكلة عموماً جرب التعديل التالي عله يفي بالغرض Sub TarhilData() Dim WS As Worksheet, SH As Worksheet Dim X As Long, Y As Long, Cell As Range Dim lRow As Long Set WS = Sheets("البيانات"): Set SH = Sheets("أجور الطبيب") Application.ScreenUpdating = False For Each Cell In WS.Range("P2:p11") If Not IsEmpty(Cell) Then X = Application.WorksheetFunction.Match(Cell.Value, SH.Rows(1), 0) lRow = SH.Cells(49, X).End(xlUp).Row + 1 WS.Range(Cell.Offset(, -14), Cell.Offset(, -12)).Copy SH.Cells(lRow, X).PasteSpecial xlPasteValues Cell.Offset(, 12).Copy SH.Cells(lRow, X + 8).PasteSpecial xlPasteValues On Error Resume Next Y = Application.WorksheetFunction.Match(Cell.Offset(, -15), Range(SH.Cells(2, X), SH.Cells(2, X + 8)), 0) SH.Cells(lRow, X + Y - 1).Value = Cell.Offset(, -1).Value On Error GoTo 0 End If Next Cell Application.CutCopyMode = False Application.ScreenUpdating = True End Sub تقبل تحياتي

أخي الكريم أبو حمادة قم بوضع الكود التالي في موديول عادي Sub ShowForm() UserForm1.Show vbModeless End Sub Sub UnhideAll() Dim Ws As Worksheet For Each Ws In ThisWorkbook.Sheets Ws.Visible = xlSheetVisible Next Ws End Sub Sub HideAll() Dim Ws As Worksheet For Each Ws In ThisWorkbook.Sheets Ws.Visible = xlSheetHidden Next Ws End Sub أنشيء فورم وعليه 4 أزرار أوامر وقم بتسمية الأزرار باسم cmdClose للإغلاق الخاص بالفورم ، وزر أمر باسم cmdSheet والذي من خلاله يمكنك التعامل مع ورقة العمل المكتوب اسمها على زر الأمر فيخفي أوراق العمل الأخرى ويبقى ورقة العمل فقط ، وزر الأمر cmdRename ويقوم بتسمية زر الأمر السابق المسمى cmdSheet (يغير عنوان الزر وليس اسم الزر) ، وأخيراً زر أمر cmdUnhide لإظهار جميع أوراق العمل وإليك الكود الذي يوضع في حدث الفورم 'Author : YasserKhalil 'Released : 25 - Dec. - 2015 'Use : This UserForm Enables You To Navigate To Specific Sheet ' Depending On cmdSheet Caption & Hide Other Sheets. '-------------------------------------------------------------------- Private Sub cmdSheet_Click() Dim Str As String, Ws As Worksheet, Bln As Boolean Str = cmdSheet.Caption On Error Resume Next For Each Ws In ThisWorkbook.Sheets Ws.Visible = xlSheetVisible If Str = Ws.Name Then Bln = True Next Ws If Bln = True Then For Each Ws In ThisWorkbook.Sheets If Ws.Name = Str Then Ws.Activate Else Ws.Visible = xlSheetHidden End If Next Ws Else MsgBox "There Is No Such Worksheet Name", 64 End If On Error GoTo 0 End Sub Private Sub cmdRename_Click() Dim StrName As String On Error Resume Next StrName = InputBox("Rename Previous Command Button", "Rename Button") If StrName <> "" Then cmdSheet.Caption = StrName On Error GoTo 0 End Sub Private Sub cmdUnhide_Click() Call UnhideAll End Sub Private Sub cmdClose_Click() Unload Me End Sub أعلم أني قد زدت عن الطلب ..فعذراً لكن الموضوع استهواني قليلاً فقمت بعمل الفورم الذي تراه بحيث يلبي حاجة من في حاجة إليه تقبل تحياتي Navigate To Specific Sheet By Command Button Name YasserKhalil.rar

أخي الكريم مارفيبو ... مش عارف معناها بس أكيد معناها لذيذ الرجاء تغيير اسم الظهور للغة العربية قم بعمل كليك يمين على اسم ورقة العمل ثم اختر الأمر View Code والصق الكود التالي وجرب إدخال تواريخ في العمود الخامس E Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 8 And Target.Column = 5 Then If IsDate(Target.Value) Then Target.EntireRow.Delete End If End Sub أرجو أن يكون المطلوب إن شاء الله جمعه مباركة عليك

وعليكم السلام ورحمة الله أبا الحسن والحسين مرورك بالموضوع شرف كبير لي .. فقد عطرته بردك بارك الله فيك وجزاك الله خيراً على دعائك الطيب

أخي الكريم رجاء لا تقوم بطرح أكثر من موضوع لنفس الطلب بالنسبة للصور زيها زي أي ملف ..انقر على كلمة "اختر ملف" وحدد الصورة من غير ما تضغطها ، وبعد ما ترفع الصورة هتلاقي علامة زائد وتلميح بيقولك أضف الصورة للمشاركة بالنسبة لمشكلتك . ارفق الملف الذي به المشكلة .حتى لا ندخل في دائرة تحمينات كما يرجى ذكر النسخة التي تعمل عليها وهل هي 32 بت أو 64 بت ؟ وذكر نسخة الويندوز التي تعمل عليها وهل هي 32 بت أم 64 بت؟

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

أخي الكريم زري الأمر حضور وانصراف يوجد في نهاية الكود المرتبط بهما سطرين لحفظ المصنف ثم الإغلاق ThisWorkbook.Save Application.Quit ما المشكلة التي تواجهها الآن؟ هل يمكنك تسجيل فيديو للمشكلة لتتضح الصورة أكثر ويستطيع الأخوة تقديم المساعدة تقبل تحياتي

الفكرة أخي الكريم السيفاني في الإعلان عن المتغيرات لا تكمن في أن يتم الأعلان عن كل متغير في سطر منفصل أو الإعلان عن كل المتغيرات في نفس السطر يمكن الإعلان عن الثلاثة متغيرات في سطر واحد ولكن يجب أن تكون كما ارفقت بالمشاركة الأولى أي يتم تحديد نوع كل متغير أما الخطأ الشائع الذي يقع فيه الكثيرون هو أن يتم الإعلان عن المتغيرات بهذا الشكل Dim c1, c2, c3 As Date هنا المتغير الثالث فقط هو الذي تم تحديد نوعه أما المتغير الأول والثاني فلم يتم تحديد نوعهما مما يترتب عليه أن يتعامل معهم المحرر أنهما من النوع Variant وليس من النوع Date أرجو أن تكون قد وصلت الفكرة

أخي الكريم أبو حمادة روح للتبويب Developer ثم انقر على Macro Security ستظهر معك نافذة اختر من الجهة اليسرى الخيار ActiveX Settings اختر الخيار الرابع Enable all controls

أخي الكريم جربت ملفك ولا يظهر معي الرسالة التي تفضلت بها عموماً ننتظر تجربة إخواننا الأعضاء ..لمعرفة ما إذا كانت المشكلة بالملف أم لا

أخي الكريم أبو يوسف جرب الكود التالي عله يفي بالغرض Sub YasserReport() Dim Ws As Worksheet, Wf As Worksheet, Cel As Range Dim TN As Long, S As String, N As String, R As Long, C As Long Set Wf = Sheets("Final") Application.ScreenUpdating = False For Each Ws In Worksheets N = Ws.Name If N Like "Sheet*" Then For Each Cel In Ws.UsedRange.Offset(20, 1).Resize(, 41) If Not Cel.Row Mod 2 = 0 And Cel.Value <> 0 Then S = Ws.Cells(Cel.Row, 45) TN = Cel.Value N = Ws.Cells(19, Cel.Column) If S <> "" Then If N = "" Then N = Ws.Cells(19, Cel.Column - 1) R = 2 Do Until Wf.Range("A" & R) = S Or _ Wf.Range("A" & R) = "" And Wf.Range("B" & R) = "" R = R + 1 Loop C = 2 Do Until Wf.Cells(R, C) = N Or Wf.Cells(R, C) = "" C = C + 2 Loop Wf.Cells(R, 1) = S Wf.Cells(R, C) = N Wf.Cells(R, C + 1) = TN End If End If Next Cel End If Next Ws Application.ScreenUpdating = True End Sub إليك الملف المرفق .. لا تنسانا بدعوة بظهر الغيب تقبل تحياتي Grab Data From Sheets Colored In Red Or White YasserKhalil.rar

أخي الحبيب أبا الحسن والحسين كود رائع وجميل وإن لم يكن مكانه في الموضوع لكنني استفدت منه كثيراً بالنسبة للسائل يريد التعامل مع زر Command Button على الفورم قمت بعمل ملف إن شاء الله يعجبكم لكنه به مشكلة بسيطة بحاول أحلها لنا عودة إن شاء الله

قد لا تكون المشكلة في الملف ..قد تكون في نسخة الأوفيس نفسها جرب تنصب نسخة أخرى غير الموجودة ..

أخي الكريم يرجى إرفاق ملفك للإطلاع عليه ومحاولة معرفة سبب المشكلة قم بالدخول على محرر الأكواد Alt + F11 واطلع على الأكواد في حدث المصنف ThisWorkbook ...حاول تحذف الأكواد الموجودة وشوف المشكلة هتتحل ولا لا ..طبعاً الشغل يكون على نسخة احتياطية مش الملف الأصلي

قم بالدخول على لوحة التحكم Control panel ثم انقر الأيقونة Region ثم اذهب لآخر تبويب المسمى Adminstrative ثم انقر على Change System Locale واختر من القائمة Arabic Egypt قم بعمل ريستارت للجهاز بعدها في انتظار ردك بعد التجربة

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

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

أخي الكريم مهند جرب الكود التالي عله يفي بالغرض - مع العلم أنه تم تقديم نفس الكود تقريباً في موضوعك السابق على هذا الرابط من هنا Sub SortData() Dim WS As Worksheet Dim LR As Long Set WS = Sheets("Sheet1") With WS LR = .Range("B" & Rows.Count).End(xlUp).Row - 1 .Range("B1:D" & LR).Sort Key1:=.Range("C1:C" & LR), Order1:=xlAscending, Header:=xlYes End With End Sub Sorting.rar

راجع رابط التوجيهات

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

أخي الكريم أبو يوسف عدد أوراق العمل كبير جداً لذا أفضل إرفاق ملف به 5 أوراق فقط للتجربة عليهم بشكل مبدئي هل تريد المخرجات تكون كلها في ورقة عمل واحدة لكل أوراق العمل الأخرى ؟؟ رجاءً ارفق شكل النتائج المتوقعة في الملف المرفق (5 أوراق عمل فقط ) لا ترفق المخرجات على شكل صورة بل أنشيء ورقة عمل جديدة وضع شكل النتائج المتوقعة ليسهل العمل على إخوانك بالمنتدى Report.rar