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

السلام عليكم ما شاء الله بارك الله بدأت الدرر تخرج من أكمامها...والأيقونات اللامعة تزخرف المكان.. في جعبتك الكثير يا أخي المهندس ياسر ....جزاك الله خيراً والسلام عليكم .

الأخ الكريم عبد الرحمن يرجى وضع الأكواد بين أقواس الأكواد لتظهر بشكل منضبط كما سترى في مشاركتي يوجد في المنتدى موضوع مشابه تماماً لطلبك فقط تعديل بسيط ليتم المطلوب إليك الكود بشكل منضبط ليظهر بشكل يسهل على الأعضاء الإطلاع عليه Sub ImportData() Dim WB As Workbook, myRng As Range Dim myRow As Long Dim shMain As Worksheet Application.ScreenUpdating = False Set shMain = ThisWorkbook.ActiveSheet Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "1.xlsx") Set myRng = WB.ActiveSheet.Range("D12:G" & WB.ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row) On Error Resume Next With shMain myRng.Copy .Range("D12").PasteSpecial xlPasteValues End With myRng.ClearContents WB.Close True Application.CutCopyMode = False Application.ScreenUpdating = True End Sub يوضع الكود في المصنف رقم 2 والمراد استيراد البيانات إليه ثم يتم مسح البيانات من المصنف رقم 1 كما طلبت لا تنسى تحديد أفضل إجابة كما لا تنسى أن تضغط على كلمة "أعجبني هذا " في المشاركة التي تعجبك تقبل تحياتي Work.rar

هذه طريقة أخرى بالمعادلات أرجو أن تحقق ماتريد تقبل تحياتى الزامي اول 2015.rar

أرجوا أن ينال رضا الجميع وكل عام وأنتم بخير تقبلوا خالص تحياتى Excel Formulas.rar

جرب الكود بهذا الشكل لعله يكون المطلوب Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [A2:F2]) Is Nothing Then If Target = "" Then AutoFilterMode = False Else Range("RN").AutoFilter , field:=Target.Column, Criteria1:="*" & Target & "*" End If End If End Sub

السلام عليكم قمت بإزالة مربعات النص وإستبدالها بخلايا الاكسل من المدى A2:F2 أصبح الكود كالتالي Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [A2:F2]) Is Nothing Then If Target = "" Then AutoFilterMode = False Else Range("RN").AutoFilter , field:=Target.Column, Criteria1:=Target End If End If End Sub هذا الكود يفيد لجميع خلايا المدى جرب المرفق اضافة وتغيير في صيغة البحث 2010.zip

هذا السطر للتعديل في مسار المصنف Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "1.xlsx") هتشيل الجزء التالي ThisWorkbook.Path وتضع مسار المصنف بين أقواس تنصيص *************************** بالنسبة لو هتتعامل مع ورقة عمل أخرى يمكنك التعديل في الجزء ActiveSheet WB.ActiveSheet بأن تستخدم كلمة Sheets ثم افتح قوس ثم علامات تنصيص وتكتب اسم ورقة العمل ثم تغلق علامات التنصيص ثم تغلق الأقواس Sheets("Data") بفرض أن ورقة العمل اسمها Data ************************ بالنسبة للرسالة ضعها في السطر قبل السطر الأخير End Sub

اخ / خالد الرشيدى بارك الله فيك ولك وفي علمك فقد وصلت المعلومه بكل كرم وجود منك .. شكرا لك بعد شكر الله تعالى... نعم هو ما اريد ..

السلام عليكم الاخ الجليل مختار حسين كل عام وانت بكل خير وعافيه كود جميل جدا سلمت يداك

المطلوب بالمرفق وان كان ما تريد قم بتحديد الموضوع كمجاب إقرار.rar

السلام عليكم ورحمة الله وبركاته أستأذن أخى وأستاذى العزيز ياسر خليل وأشارككم بهذه المحاولة التى أعتبرها بداية جيدة أتفق مع رأى أستاذى العزيز ياسر الأخير بالمشاركة 9 حيث يتم تصدير كل توجيه الى مصنف مستقل ويتم تصدير كل التوجيهات الى مصنف عام يجمع الكل فهو الأيسر والأسهل والأقرب الى الصواب فبدلا من أن يكون هناك زر أمر لكل توجيه على حدا وأكواد متعددة يكفى زر واحد وكود واحد يقوم بذلك : الكود : Sub MOKHTARTSET() Dim myDir As String, C As Range, WB As Workbook, NWB As Workbook, Rng1 As Range, Rng2 As Range Set WB = ThisWorkbook myDir = ActiveWorkbook.Path & "\" & "My Workbook" Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next MkDir myDir On Error GoTo 0 '--------------------------------------------------------------------------------- WB.Sheets("Final").Select Columns("F:Q").Select Selection.EntireColumn.Hidden = True Set Rng1 = WB.Sheets("Final").Range("d7:s27").SpecialCells(xlCellTypeVisible) Rng1.Select Selection.Copy Set NWB = Workbooks.Add ActiveSheet.Range("A4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Range("A4:D24").Select With Selection .HorizontalAlignment = xlCenter .Font.Size = 10 .Borders.LineStyle = xlContinuous End With ActiveSheet.Range("B2") = "قـــــوائم التوجهـــــــات الكلـــــية " NWB.SaveAs Filename:=myDir & "\" & "قـــــوائم التوجهـــــــات الكلـــــية " & ".xlsx", CreateBackup:=False NWB.Close WB.Activate WB.Sheets("Final").Cells.Select Selection.EntireColumn.Hidden = False Range("X11").Select '-------------------------------------------------------------------------------------- For Each C In Sheets("Final").Range("U12:U23") WB.Sheets("Final").Range("AA1").Value = C.Value ' ------------------------------------------------------------------------------- WB.Sheets("Final").Activate Range("D7:S7").Select Selection.AutoFilter ActiveSheet.Range("$D$7:$S$27").AutoFilter Field:=16, Criteria1:="=" & C.Value, Operator:=xlAnd Range("F:Q,S:S").Select Selection.EntireColumn.Hidden = True Set Rng2 = WB.Sheets("Final").Range("D7:R27").SpecialCells(xlCellTypeVisible) Rng2.Select Selection.Copy Set NWB = Workbooks.Add ActiveSheet.Range("A4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Range("A4:D10").Select With Selection .HorizontalAlignment = xlCenter .Font.Size = 10 .Borders.LineStyle = xlContinuous End With ActiveSheet.Range("B2") = "الموجهون الى" ActiveSheet.Range("C2") = C.Value NWB.SaveAs Filename:=myDir & "\" & C.Value & ".xlsx", CreateBackup:=False NWB.Close WB.Activate WB.Sheets("Final").Cells.Select Selection.EntireColumn.Hidden = False Selection.AutoFilter Range("A1").Select '----------------------------------------------------------------------------------- Next C Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub الكود ينتج عنه الملفات المطلوبة داخل مجلد باسم My Workbook فى مسار الملف أرجو أن يكون هو المطلوب. Pupils Distribution According To Marks & Wishees by mokhtar .rar

السلام عليكم و رحمة الله و بركاته محاولة بسيطة مأخوذة من منتدانا الغالي أوفيسنا ربما تفي بالغرض الشكر موصول لصاحبها تحويل التاريخ الهجري و الميلادي.rar

هديه جميله ورائعه جزاكم الله خير

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

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

جرب الكود بهذا الشكل Sub ClearExceptFormulas() Union(Range("D10:I49"), Range("I50:I53")).SpecialCells(xlCellTypeConstants).ClearContents End Sub

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

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

ولايهمك أبا البراء كما اتفقنا كثيرا لااعتذار ولايحزنون المهم السائل يستفيد ================= عشان مافيش حاجة اسمها Worksheet_open توقعت ان يكون السائل مبتديء (كما كنا جميعا) وتوقعت ايضا ان يكون في حدث الورقة وهو لم يحسن توصيل الطلب ولكن يبدو ان كلامك انت الاصح تقبل ودي واحترامي

إنها لغة وليس نوع الخط

أخي الكريم مجدي إليك الملف الأصلي الذي أرفقته الملف المضغوط باسم "نموذج إستمرارية عمل" قم بفك الضغط عنه ستجد مصنفين أحدهما باسم "نموذج إستمرارية عمل" والآخر باسم "ملف البيانات" قم بفتح المصنف الذي يحتوي الكود "نموذج إستمرارية عمل" وغير الرقم في الخلية B1 ولاحظ النتائج نموذج إستمرارية عمل.rar

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

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

أخي الكريم يرجى يرجى يرجى (3 يرجى) تغيير اسم الظهور للغة العربية يرجى الالتزام بالتوجيهات من خلال قراءة رابط التوجيهات في الموضوعات المثبتة بالمنتدى يرجى وضع الكود بين أقواس الكود ليظهر بشكل منضبط كما يتم في مشاركتي بعد قليل يرجى معرفة مصدر الكود - لأني أول مرة أشوف حاجة اسمها Worksheet_open مفيش حدث اسمه كدا قمت بإزالة الأجزاء الغير ضرورية بالكود والتي ليس لها فائدة والابقاء على ما يؤدي الهدف فقط جرب الكود التالي Private Sub Workbook_Open() With Range("A1", Cells(Rows.Count, "A").End(xlUp)) Range("B1").Resize(.Rows.Count).Value = .Value End With End Sub يوضع الكود في حدث المصنف أي Workbook لا تنسى أن تحدد أفضل إجابة في حالة أن تم حل المشكلة وأن تضغط على كلمة "أعجبني هذا "في حالة أعجبتك المشاركة وأعجبك الحل

السلام عليكم أخي الكريم عدل الكود ليصبح كالتالي Private Sub Worksheet_Activate() With Range("A1", Cells(Rows.Count, "A").End(xlUp)) Range("B1").Resize(.Rows.Count).Value = .Value End With End Sub

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

مشكوووووووووور على المجهود الرائع

انظر هنا ستجد فائدة بإذن الله http://www.officena.net/ib/?showtopic=42659

اتفضل اخى الفاضل وأتمنى من الله بأن يكون هو المطلوب دور ثان_1.rar

هههههههههههههههههههههه المعذرة استاذي الكريم والله ما انتبهت اسف واشكرك

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

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

هل قمت بتغيير اسم المصنف الذي يتم جلب البيانات منه كما في الكود ... شوف اسم المصنف عندك وعدل في الكود بالاسم في السطر Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "Data Base.xlsx") يعني شوف اسم المصنف ايه اللي إنت بتاخد منه البيانات وعدل هذا السطر بما يناسب اسم ملفك

قمت برفع الملف - إذا لم يكن الأمر يضايقك بالطبع - ليستفيد أكبر قدر من الأعضاء يبدو أنك محترف أخي مستر اكسل .. نتمنى تواجدك معنا تساهم في الحلول التي تقدم للأعضاء يرجى تغيير اسم الظهور للغة العربية كما يرجى قراءة كتيب التعليمات والتوجيهات في الموضوعات المثبتة بالمنتدى ننتظر منك الكثير فلا تبخل علينا أخي الفاضل تقبل وافر تقديري واحترامي SUBTOTAL.rar

السلام عليكم ورحمة الله أستاذى الفاضل بن عليه حاجى كل سنة وحضرتك طيب حل رائع من أستاذ أروع أخى صلاح جرب هذا المرفق تم فيه استعمال خاصية الفلترة ثم عمل الـ pdf كما طلبت فى مشاركتك الكود Sub FilterthenPDFcellvalue() Dim Rng As Range Dim fName As String fName = "D:\" & ActiveSheet.[E2].Value Application.ScreenUpdating = False With Sheets("كشف الحساب ") .AutoFilterMode = False .Range("D4:S5").AutoFilter Field:=1, Criteria1:="<>" Set Rng = Sheets("كشف الحساب ").Range(Cells(1, 4), Cells(Rows.Count, 19)) Rng.Activate Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False .Select .Cells.AutoFilter Range("d2").Select End With Application.ScreenUpdating = True End Sub المرفق Hide Blank Rows Using AutoFilter then pdf mokhtar .rar

السلام عليكم ورحمة الله أخي الكريم، تم تطويع كود للطباعة بصيغة PDF من موضوع سابق لأخي الحبيب أبو حنين (وأستسمحه في ذلك) مع بعض التعديلات عليه وإضافة تسميات ضرورية لعمل هذا الكود... وأيضا تم مسح خاصية دمج المراسلات من بعض الخلايا (الخلايا التي تحوي كلمتي "كشف الحساب" و "الاجمالي") واستبدال الدمج باستعمال خاصية "توسيط عبر التحديد"... أرجو أن يكون هذا جزء من المطلوب... ولم أستعمل في الكود خاصية AutoFilter بل استعملت خاصية "الإخفاء"... أخوك بن علية Hide Blank Rows Using AutoFilter.rar

أخي الكريم مجدي الطيب جرب الكود التالي (قمت بتغيير اسم المصنف للغة الإنجليزية ..يمكنك تسميته باللغة العربية وتعديل الاسم في الكود ..فقط لسهولة التعامل مع الكود قمت بتغيير اسم المصنف ) Sub ImportData() Dim WB As Workbook, rngLookup As Range Dim myRow As Long Dim shMain As Worksheet Application.ScreenUpdating = False Set shMain = ThisWorkbook.ActiveSheet Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & "Data Base.xlsx") Set rngLookup = WB.ActiveSheet.Range("B3:B" & WB.ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row) On Error Resume Next With shMain myRow = Application.WorksheetFunction.Match(.Range("B1"), rngLookup, 0) + 2 Union(.Range("C8"), .Range("K8"), .Range("D11"), .Range("C14"), .Range("G14"), .Range("K14")).ClearContents .Range("C8") = WB.ActiveSheet.Cells(myRow, "C") .Range("K8") = WB.ActiveSheet.Cells(myRow, "E") .Range("D11") = WB.ActiveSheet.Cells(myRow, "D") .Range("C14") = WB.ActiveSheet.Cells(myRow, "F") .Range("G14") = WB.ActiveSheet.Cells(myRow, "G") .Range("K14") = WB.ActiveSheet.Cells(myRow, "H") End With WB.Close False Application.ScreenUpdating = True End Sub لا تنسى أن تحدد أفضل إجابة وأن تضغط على كلمة "أعجبني هذا" إذا نالت المشاركة إعجابكم تقبل تحياتي Import Data From Closed Workbook.rar

وعليكم السلام ورحمة الله وبركاته نعم أبو عبد الرحمن تستطيع ذلك باستخدام عامل التصفية أي الفرز فقط تحدد جميع التواريخ أو جميع الخلايا المعنية ثم تذهب إلى ادراج ثم تختار جدول فتظهر علبة حوار للخلايا المحددة ثم موافق في العمود3 تختار "التواريخ" الفرز من الأقدم إلى الأحدث وهكذا .... التعديل في المرفق وأرجوأني قد أجبت على سؤالك . الزامي اول 2015.zip

أخي الغالي ابن الملك ولما استخدام زر ويوجد بالفعل على يسار شريط المعادلات الاختصار FX .. ما الهدف من الطلب الغريب والعجيب؟

اخى الكريم لست سوى طالب واتعلم مثلك دعنا نتكلم سويا لكل طالب اكثر من ماده صح هل لكل مدرس اكثر من ماده ليدرسها ام واحده فقط لكل مدرس صف او اكثر صح

أخى الفاضل / غسان العبيدي

بارك الله فيك أخي الحبيب غسان وجزاك الله خيراً كم أعشق موضوعاتك المتميزة ! تقبل تحياتي

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

أخي الحبيب غسان مجهود رائع تشكر عليه ..جزاكم الله خيرا تقبل تحياتي

جزاك الله خيرا تقبل خالص تحياتي

جزاكم الله خيرا

استاذ GhassanFd فكرة جميلة جداً جزاكم الله خيراً