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

جرب الكود التالي Sub BreakLinks() Dim WB As Workbook Dim Link Set WB = Application.ActiveWorkbook If Not IsEmpty(WB.LinkSources(xlExcelLinks)) Then For Each Link In WB.LinkSources(xlExcelLinks) WB.BreakLink Link, xlLinkTypeExcelLinks Next Link End If End Sub

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

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

بارك الله فيك أخي الحبيب وائل .. إليك نفس الكود بطريقة مماثلة تقريباً مع تصنيف الشروط حسب الفصل الدراسي الأول أو الثاني ، ثم داخل كل شرط الشروط الأخرى Private Sub Worksheet_Activate() With ActiveSheet .Unprotect .AutoFilterMode = False If .Range("I1").Value = "الأول" Then If .Range("I2").Value = "التاسع" Or .Range("I2").Value = "السادس" Then .Range("A12:F12").AutoFilter Field:=4, Criteria1:=">=16", Operator:=xlAnd ElseIf .Range("I2").Value = "الرابع" Or .Range("I2").Value = "الخامس" Or .Range("I2").Value = "السابع" Or .Range("I2").Value = "الثامن" Or .Range("I2").Value = "العاشر" Or .Range("I2").Value = "الحادي عشر" Then .Range("A12:F12").AutoFilter Field:=4, Criteria1:=">=24", Operator:=xlAnd End If ElseIf .Range("I1").Value = "الثاني" Then If .Range("I2").Value = "التاسع" Or .Range("I2").Value = "السادس" Then .Range("A12:F12").AutoFilter Field:=4, Criteria1:=">=32", Operator:=xlAnd ElseIf .Range("I2").Value = "الرابع" Or .Range("I2").Value = "الخامس" Or .Range("I2").Value = "السابع" Or .Range("I2").Value = "الثامن" Or .Range("I2").Value = "العاشر" Or .Range("I2").Value = "الحادي عشر" Then .Range("A12:F12").AutoFilter Field:=4, Criteria1:=">=24", Operator:=xlAnd End If End If .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End With End Sub

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

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

أخي الكريم صلاح المصري إليك كود الاستدعاء ..يعتمد على فلترة البيانات ثم نسخ الخلايا الظاهرة في العمودين G و H Sub MultipleFilter() Dim WS As Worksheet, SH As Worksheet, RngData As Range, RngCopy As Range Set WS = Sheets("Rawdata"): Set SH = Sheets("فاتورة بيع") Set RngData = WS.Range("A6:R" & WS.Cells(Rows.Count, 1).End(xlUp).Row) Application.ScreenUpdating = False With WS .AutoFilterMode = False With .Range("A5:R5") .AutoFilter Field:=2, Criteria1:=SH.Range("I4").Value .AutoFilter Field:=3, Criteria1:=SH.Range("I5").Value .AutoFilter Field:=4, Criteria1:=SH.Range("C5").Value .AutoFilter Field:=5, Criteria1:=SH.Range("B2").Value End With Set RngCopy = Intersect(.Columns("G:H"), RngData.SpecialCells(xlCellTypeVisible)) RngCopy.Copy SH.Range("B8").PasteSpecial xlPasteValues End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

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

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

أخي الغالي صلاح المصري أخي الحبيب سعد عابد بارك الله فيكما وجزيتما خيراً على مروركما العطر بالموضوع

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

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

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

أخي الكريم جرب الكود التالي يقوم بقسمة الخلية في العمود H على الخلية في العمود E .. والنتيجة في الخلية في العمود I كما طلبت في المشاركة الأولى Sub MyTest() Dim Cell As Range For Each Cell In Range("I1:I" & Cells(Rows.Count, "E").End(xlUp).Row) Cell.Value = Cell.Offset(, -1) / Cell.Offset(, -4) Next End Sub تعلم.rar

أخي الكريم ارفق ملفك ليسهل الوصول للمطلوب بشكل أفضل وأسرع

بارك الله فيك أخي الحبيب رمهان ولكن ما تزال النتائج مختلفة ..جرب الدالتين بنفسك وقارن النتائج يمكن عمل تعديل بسيط على الدالة الرائعة التي قدمتها لنصل لنتائج صحيحة إن شاء الله Function Ramhan(Xinput As String) As String Dim I As Long, Xsum As String, Xletter As String Xletter = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي" Xinput = Replace(Xinput, "أ", "ا") Xinput = Replace(Xinput, "إ", "ا") Xinput = Replace(Xinput, "ة", "ه") Xinput = Replace(Xinput, " ", "") For I = 1 To Len(Xinput) Xsum = Xsum & " " & Mid("ابجدهوزحطيكلمنسعفصقرشتثخذضظغ", InStr(1, Xletter, Mid(Xinput, I, 1)), 1) Next I Ramhan = Trim(Xsum) End Function

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

أخي الحبيب ياسر فتحي أخي ومعلمي الغالي عادل حنفي (أما آن أن تغير اسم الظهور للغة العربية) منورين الموضوع بردودكم الجميلة تقبلوا تحياتي

أخي الكريم يرجى تغيير اسم الظهور للغة العربية إليك الملف المرفق فيه ما طلبت إن شاء الله Sub ClosedWorkbook() Dim WB As Workbook Dim LR As Long Dim Purch As Double, Sales As Double, Expense As Double LR = Cells(Rows.Count, "I").End(xlUp).Row Application.ScreenUpdating = False Purch = Range("O24").Value Sales = Range("L24").Value Expense = Range("I24").Value Set WB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "حساب اجمالي المبيعات .xlsx") With WB.Sheets("Sheet1") .Range("O5") = Purch: .Range("L5") = Sales: .Range("I5") = Expense End With WB.Close SaveChanges:=True Application.ScreenUpdating = True End Sub يتم تحديث الإجمالي في المصنف "حساب اجمالي المبيعات " من خلال زر أمر بدون فتح المصنف ..يتم فتح المصنف المغلق وتحديث بياناته ثم الحفظ والإغلاق بالكود أرجو أن يكون المطلوب Closed Workbook.rar

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

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

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

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

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

السلام عليكم ورحمة الله وبركاته نبدأ بعون الله في شرح شيء جديد في عالم البرمجة ، وهو القاموس Dictionary ، وإن شاء المولى يكون مفيد لكم إخواني الكرام. طبعاً عنوان الموضوع جذبكم مش عشان البرمجة أكيد عشان الناموس (وإزاي نقدر نتخلص من الناموس والإزعاج اللي بيسببه ) .. الناموس هنا معناه القانون أو القاعدة .. ودا عنوان كعامل جذب مش أكتر ما هو القاموس Dictionary؟ ---------------------------- من اسمه ممكن نعرفه ..القاموس يعني تجميعة كلمات باللغة الإنجليزية وليها مرادف سواء بنفس اللغة أو بلغة أخرى .. اللي يهمنا في القاموس إني عبارة عن تجميعة Collection القاموس في لغة البرمجة عبارة عن تجميعة ، وبنستخدمه عشان نخزن فيه : أرقام - نصوص - تواريخ - مصفوفات نطاقات - كائنات - متغيرات .. والقاموس عبارة عن عناصر أو بنود Items وكل عنصر له مفتاح مميز Unique Key المفتاح دا فايدته ايه؟ من اسمه بردو نعرف إن المفتاح بيفتح لنا الباب .. بيفتح الباب للعنصر (عشان نتعامل معاه بشكل برمجي .. يعني المفتاح دليلنا أو مرشدنا للعنصر المطلوب التعامل معه) القاموس فايدته إننا بنقدر نتعامل مع البيانات في الذاكرة بعيداً عن ورقة العمل ..يعني مفيش تحديث للشاشة Screen Updating ، مفيش حساب تلقائي Auto Calculation ، بكدا نقدر نفول إنه أسرع في التعامل مع البيانات ++ (فائدة) بما إن القاموس بيحتوي على مفاتيح مميزة ، فيمكن استخدام الخاصية .Keys عشان نستخرج قائمة فريدة Unique List من البيانات ** القاموس ليس ضمن المكتبة القياسية للغة البرمجة VBA ، إنما هي جزء من Microsoft Scripting Runtime library ، وهذه المكتبة توجد في الملف الموجود في المسار التالي \Windows\system32\scrrun.DLL ولذلك إذا أردت استخدام القاموس فيمكنك من خلال محرر الأكواد الذهاب للقائمة Tools ثم References واختر المكتبة المسماة Microsoft Scripting Runtime library إنشاء القاموس Create Dictionary ----------------------------------- أبسط طريقة لإنشاء القاموس استخدام الأسطر التالية With CreateObject("scripting.Dictionary") End With ماذا تعني هذه الأسطر؟ تعني إنشاء كائن جديد بالاعتماد على المكتبة المسماة scripting.Dictionary ، وما بين السطرين سيتم كتابة أسطر وأوامر برمجية الأسطر التي ستبدأ بنقطة تعني التعامل مع خصائص الكائن أي أنها ستتعامل مع الكائن الجديد ## مثال بسيط لإضافة عنصر للقاموس With CreateObject("scripting.dictionary") .Add "First Name", "Yasser" End With الطريقة Method التي تلي النقطة تسمى Add أي أضف .. والمقصود منها إضافة عنصر جديد للقاموس .. ذكرنا في بداية الموضوع أن لكل عنصر مفتاح مميز ، المفتاح هنا First Name ، والعنصر يحتوي على النص Yasser يمكن استخدام متغير للقاموس بهذا الشكل Dim Dict As Object Set Dict = CreateObject("scripting.dictionary") With Dict .Add "First Name", "Yasser" End With الإعلان عن المتغير من النوع كائن ، ثم تعيين قيمة للمتغير ليساوي إنشاء الكائن من المكتبة الخاصة scripting.Dictionary ثم بدء التعامل مع الكائن القاموس .. ## مثال آخر : المثال التالي سيتناول عد العناصر داخل القاموس باستخدام الخاصية Count قم بوضع الكود داخل موديول ثم نفذ الكود ستجد رسالة بها عدد عناصر القاموس وهو في المثال 2 فقط مفتاح العنصر الأول هو First Name ومفتاح العنصر الثاني هو Second Name أما كلمة Yasser وكلمة Khalil فهي محتويات أو عناصر القاموس With CreateObject("scripting.dictionary") .Add "First Name", "Yasser" .Add "Last Name", "Khalil" MsgBox .Count End With وأكتفي بهذ الجزء البسيط .. لكي أجد المتابعة الجيدة منكم وإلى اللقاء في الأسبوع المقبل إن شاء الله مع حلقة جديدة في نفس الموضوع دمتم على طاعة الله