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

أخي الكريم هاني يرجى توضيح نوع الطابعة المراد الطباعة عليها كما يرجى ذكر البورت الخاص بالطابعة وذلك حتى يمكنك تحديد هذه الطابعة لاستخدامها في الملف دون تغيير الطابعة الافتراضية للجهاز .. لو عايز تعرف تفاصيل الطابعة والبورت الموصل بيها يمكنك استخدام الكود التالي ..غير الطابعة وخليها افتراضية وبعدين نفذ الكود التالي لمعرفة تفاصيلها Sub Test() Range("A1").Value = Application.ActivePrinter End Sub

شرح فوق الخيال أخي الحبيب خالد بارك الله فيك وفي وقتك وفي أولادك وفي علمك .. تقبل تحياتي

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

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

بارك الله فيك أخي الحبيب ياسر فتحي على موضوعاتك المميزة

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

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

أخي وحبيبي في الله طلعت بارك الله فيك وجزيت خيراً على كلماتك الرقيقة ومرورك الرائع

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

أكرر مرة أخرى أخي الكريم هاني بالنسبة لزيادة عدد الشيتات .. كل ما عليك فعله التعديل في سطر واحد فقط كي يشمل الشيتات الجديدة SheetsArr = Array("مصلحه 1", "مصلحه 2", "مصلحه 3") أما بالنسبة لإضافة النواحي الجمالية فلا إشكال ... ولكن أفضل مراجعة الكود بعد تعديل الملف كما تعمل عليه لا يمكن تخمين حدوث مشكلة قبل حدوثها إذ أنني لا أدري ما هو شكل الملف بعد التعديل ...!! أعتقد من الأفضل عمل الملف كما تريده تماماً ثم طرح نموذج منه لمراجعة الكود مع التعديل أما التخمين فاعذرني لا يمكنني التخمين ... أرجو أن تكون اتضحت الصورة تقبل تحياتي

أخي الكريم عبد العزيز جزيت خيراً على ردك الطيب يرجى عدم استخدام الاقتباسات الطويلة ...

شرفني مرورك أخي الحبيب الغائب عن العين الحاضر في القلب أحمد الحاوي (ياما في الجراب يا حاوي)

أخي الكريم ابو سليمان بالنسبة لجزئية تسجيل الماكرو يمكنك فتح الباب الثالث ..في حلقات افتح الباب يا أبو سليمان (وبطل أكل الرمان ..عشان أكله أنا ...) من هنا

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

أخي الكريم هاني الحمد لله أن نال الملف إعجابك .. بالنسبة لزيادة عدد الشيتات يرجى وضع شكل الملف الأصلي بالضبط لمعرفة عدد الشيتات الموجودة بالكامل .. وهل أوراق العمل التي سيتم زيادتها ستكون كلها تبدأ بكلمة مصلحة أم أن الأمر مختلف..؟؟ يمكنك التعديل في الكود في سطر واحد لتحصل على النتيجة المطلوبة من خلال هذا السطر SheetsArr = Array("مصلحه 1", "مصلحه 2", "مصلحه 3") هذا السطر من خلاله يمكنك وضع أوراق العمل المطلوب العمل عليها بنفس الشكل .. Sub CreateOneSheet() Dim SheetsArr, SH As Worksheet, WS As Worksheet Dim I As Long, LR As Long, Count As Long Dim strSheet As String Set WS = Sheets("اذون الصرف") strSheet = WS.Range("K7").Value Application.DisplayAlerts = False Application.ScreenUpdating = False If Not Evaluate("ISREF('Temp'!A1)") Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Temp" Sheets("Temp").Cells.Clear If strSheet = "كل المصالح" Then SheetsArr = Array("مصلحه 1", "مصلحه 2", "مصلحه 3") For I = 0 To UBound(SheetsArr) For Each SH In Sheets If SH.Name = SheetsArr(I) Then With SH LR = IIf(Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row < 2, 1, Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row + 1) .Range("A1").CurrentRegion.Offset(1).Copy Sheets("Temp").Range("A" & LR) Count = Application.WorksheetFunction.Count(Sheets("Temp").Range("A" & LR & ":A" & Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row)) Sheets("Temp").Range("E" & LR).Resize(Count) = .Name Sheets("Temp").Range("F" & LR).Resize(Count).Formula = "=Ar_WriteDownNumber(" & Sheets("Temp").Range("D" & LR).Address(0, 0) & ", ""جنيه"", ""قرش"")" End With End If Next SH Next I Else With Sheets(strSheet) LR = IIf(Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row < 2, 1, Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row + 1) .Range("A1").CurrentRegion.Offset(1).Copy Sheets("Temp").Range("A" & LR) Count = Application.WorksheetFunction.Count(Sheets("Temp").Range("A" & LR & ":A" & Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row)) Sheets("Temp").Range("E" & LR).Resize(Count) = .Name Sheets("Temp").Range("F" & LR).Resize(Count).Formula = "=Ar_WriteDownNumber(" & Sheets("Temp").Range("D" & LR).Address(0, 0) & ", ""جنيه"", ""قرش"")" End With End If With Sheets("Temp") For I = 1 To .Cells(Rows.Count, 1).End(xlUp).Row Step 2 WS.Range("G4") = .Cells(I, "E") WS.Range("D6") = .Cells(I, "F"): WS.Range("D14") = .Cells(I, "F") WS.Range("C7") = .Cells(I, "C") WS.Range("B11") = .Cells(I, "D"): WS.Range("B14") = .Cells(I, "D") WS.Range("D12") = .Cells(I, "B") WS.Range("G24") = .Cells(I + 1, "E") WS.Range("D26") = .Cells(I + 1, "F"): WS.Range("D34") = .Cells(I + 1, "F") WS.Range("C27") = .Cells(I + 1, "C") WS.Range("B31") = .Cells(I + 1, "D"): WS.Range("B34") = .Cells(I + 1, "D") WS.Range("D32") = .Cells(I + 1, "B") WS.PrintPreview Next I .Delete End With MsgBox "Done", 64 Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub أخي الكريم هاني تم إنشاء قائمة منسدلة في الخلية K7 ومصدرها في العمود N وعملت إخفاء للعمود يمكنك الآن اختيار أي مصلحة أو كل المصالح كما ترغب Create One Sheet YasserKhalil V2.rar

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

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

أخي الكريم عبد الرحمن تفضل الكود Sub Clear() With Worksheets("Sheet1") .Unprotect 1 .Range("date,time,results,tester").SpecialCells(xlCellTypeConstants).ClearContents .Protect 1 End With With Worksheets("Sheet2") .Unprotect 1 .Range("date1,time1,results1,tester1").SpecialCells(xlCellTypeConstants).ClearContents .Protect 1 End With End Sub

الحمد لله أن تم المطلوب على خير وجزيت خيراً أخي الحبيب أبو عيد

Sub CreateOneSheet() Dim SheetsArr, SH As Worksheet, WS As Worksheet Dim I As Long, LR As Long, Count As Long Set WS = Sheets("اذون الصرف") Application.DisplayAlerts = False Application.ScreenUpdating = False If Not Evaluate("ISREF('Temp'!A1)") Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Temp" Sheets("Temp").Cells.Clear SheetsArr = Array("مصلحه 1", "مصلحه 2", "مصلحه 3") For I = 0 To UBound(SheetsArr) For Each SH In Sheets If SH.Name = SheetsArr(I) Then With SH LR = IIf(Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row < 2, 1, Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row + 1) .Range("A1").CurrentRegion.Offset(1).Copy Sheets("Temp").Range("A" & LR) Count = Application.WorksheetFunction.Count(Sheets("Temp").Range("A" & LR & ":A" & Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row)) Sheets("Temp").Range("E" & LR).Resize(Count) = .Name Sheets("Temp").Range("F" & LR).Resize(Count).Formula = "=Ar_WriteDownNumber(" & Sheets("Temp").Range("D" & LR).Address(0, 0) & ", ""جنيه"", ""قرش"")" End With End If Next SH Next I With Sheets("Temp") For I = 1 To .Cells(Rows.Count, 1).End(xlUp).Row Step 2 WS.Range("G4") = .Cells(I, "E") WS.Range("D6") = .Cells(I, "F"): WS.Range("D14") = .Cells(I, "F") WS.Range("C7") = .Cells(I, "C") WS.Range("B11") = .Cells(I, "D"): WS.Range("B14") = .Cells(I, "D") WS.Range("D12") = .Cells(I, "B") WS.Range("G24") = .Cells(I + 1, "E") WS.Range("D26") = .Cells(I + 1, "F"): WS.Range("D34") = .Cells(I + 1, "F") WS.Range("C27") = .Cells(I + 1, "C") WS.Range("B31") = .Cells(I + 1, "D"): WS.Range("B34") = .Cells(I + 1, "D") WS.Range("D32") = .Cells(I + 1, "B") WS.PrintPreview Next I .Delete End With MsgBox "Done", 64 Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub أخي الكريم هاني حرحش .. قمت بعمل الكود بفكرة تجميع أوراق العمل في ورقة واحدة يتم تجميع البيانات بها وتفقيط المبالغ بها ووضع اسم المصلحة لكل عميل في ورقة عمل باسم Temp والتي يتم حذفها بانتهاء عمل الكود .. في السطر التالي قرب نهاية الكود WS.PrintPreview ستقوم باستبدال كلمة PrintPreview بكلمة Printout للطباعة (عملت معاينة فقط في الكود ..) يمكنك تغييرها لتقوم بالطباعة بشكل مباشر إليك الكود المستخدم ... برجاء الانتباه ..أعتقد أنه لن تقوم بعمل معاينة لكل العملاء .. ولذلك لكي توقف عمل الكود اضغط Ctrl + Pause Break للخروج من الإجراء أتمنى أن يكون المطلوب إن شاء الله تقبل وافر تقديري واحترامي Create One Sheet YasserKhalil.rar

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

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

أخي الكريم يمكنك الإطلاع على هذا الموضوع لمعرفة كيفية التعامل مع محرر الأكواد كبداية بداية الطريق لإنقاذ الغريق كما يمكنك مشاهدة الفيديو التالي https://www.youtube.com/watch?v=9X7hlw4G6r8

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

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