saad abed

اخى محمد هشام الكود يعمل بكفاءه عاليه جزاك الله خيرا اخى محمد عامل السرعه فى كود تحويل الملفات هل الغاء الرسائل يعمل على زيادة سرعة الكود

السلام عليكم ورحمة الله وبركاته فى الموضوع السابق تم عمل كود عن طريق اخى محمد هشام واخى عبدالله يمكنى من حذف ملفات اكسيل ذات امتداد معين ونقله الى فولدر فى السى واليوم اطلب نفس الطريقة ولكن لتحويل الامتداد .xlsb الى .xlsx كل الشكر للمشرفين والخبراء فى هذا المنتدى الحبيب

اخى عبدالله الكود يعمل بكفاءه جزاك الله خيرا

اخى محمد هشام تم التجريب الكود يعمل بكفاءة فى الملفات التى على الدرايف مباشرة اما التى داخل فولدرات فلا تتاثر بالكود

إللهم أذهب البأس ربّ النّاس، اشف وأنت الشّافي، لا شفاء إلا شفاؤك، شفاءً لا يغادر سقماً، أذهب البأس ربّ النّاس، بيدك الشّفاء، لا كاشف له إلّا أنت يارب العالمين اشفى ابن محمد هشام اللهم امين

اخى عبدالله بشير عبدالله اخى محمد هشام كل الشكر والتقدير لكم اخوتى الاكارم جارى التجربه ولكن مجهودكم كبير تشكرون عليه جزاكم الله خيرا

السلام عليكم اخى محمد نعم اريد حذف ملفات الاكسيل ذات الامتداد .xlsb من دريف معين حاول كتابة الكود وسنرى مع التجربة كيف نتلافى البطء ان شاء الله

السلام عليكم هل هناك كود يمكنى من الالغاء ملفات اكسيل بامتداد معين مثلا .xlsb فى درايف معين او فى كل الدريفات

السلام عليكم ورحمه الله وبركاته جزاك الله كل خير استاذ ضاحي

السلام عليكم ورحمه الله وبركاته احسنت وجزاك الله عنا خير الجزاء استمر والله اعمال رائعه

اخى ضاحى احسنت وجزاك الله خيرا وصلت الفكره والله مفيده جدا

السلام عليكم يفضل اضافة سطر لمسح الداتا Sht6.Range("A3:Q100000").ClearContents

اخى اكتب انت اسم الورقة Private Sub CreateSheet() Dim ws As Worksheet ss = InputBox("name is ........") Set ws = Sheets.Add(After:=Sheets(Sheets.Count)) ws.Name = ss End Sub

جرب الاتى Sub SaveBill() On Error Resume Next Dim Lrow As Integer Lrow = ورقة3.Cells(ورقة3.Rows.Count, "a").End(xlUp).Offset(1, 0).Row ورقة3.Cells(Lrow, "A") = sheet1.Cells(2, "B") ورقة3.Cells(Lrow, "B") = sheet1.Cells(3, "B") ورقة3.Cells(Lrow, "C") = sheet1.Cells(4, "B") ورقة3.Cells(Lrow, "D") = sheet1.Cells(29, "D") ورقة3.Cells(Lrow, "E") = sheet1.Cells(29, "F") ورقة3.Cells(Lrow, "F") = sheet1.Cells(30, "F") ورقة3.Cells(Lrow, "G") = sheet1.Cells(31, "F") ورقة3.Cells(Lrow, "H") = sheet1.Cells(32, "F") ورقة3.Cells(Lrow, "I") = sheet1.Cells(33, "F") Dim LastRow As Integer Dim R As Integer '''''''''''''''''''''''''''''''' For R = 7 To 27 If (sheet1.Cells(R, "b") <> "") Then LastRow = ورقة2.Cells(ورقة2.Rows.Count, "A").End(xlUp).Offset(1, 0).Row ورقة2.Cells(LastRow, "A") = sheet1.Cells(2, "B") ورقة2.Cells(LastRow, "B") = sheet1.Cells(3, "B") ورقة2.Cells(LastRow, "C") = sheet1.Cells(4, "B") ورقة2.Cells(LastRow, "D") = sheet1.Cells(R, "B") ورقة2.Cells(LastRow, "E") = sheet1.Cells(R, "C") ورقة2.Cells(LastRow, "F") = sheet1.Cells(R, "D") ورقة2.Cells(LastRow, "G") = sheet1.Cells(R, "E") ورقة2.Cells(LastRow, "H") = sheet1.Cells(R, "F") End If Next '''''''''''''''''''''''''''''''''''''''' sheet1.Range("b2").ClearContents sheet1.Range("b3").ClearContents sheet1.Range("b4").ClearContents sheet1.Range("b7:e27").ClearContents End Sub غيرت اسم الورقة من ورقه1 الى sheet1

اخى هذا الشرط يمنع مسح المجال لانه ينهى عمل الكود اذا تحقق الشرط If (sheet1.Cells(R, "b") = "") Then ' Exit Sub ' End If جرب اوقف عمل الاسطر وجرب سترى ان كل شئ على ما يرام

فهمت ما تريد استخدمت مقسم العرض يعمل من اوفيس اعلى من 2010 اختار من مقسم العرض لعمود اكس تنشن انسخ الرقم فى خليه h8 datea.xlsx

اخى الكريم غير اكواد التفريغ خارج الحلقه المتكرره Sub SaveBill() On Error Resume Next Dim Lrow As Integer Lrow = ورقة3.Cells(ورقة3.Rows.Count, "a").End(xlUp).Offset(1, 0).Row ورقة3.Cells(Lrow, "A") = ورقة1.Cells(2, "B") ورقة3.Cells(Lrow, "B") = ورقة1.Cells(3, "B") ورقة3.Cells(Lrow, "C") = ورقة1.Cells(4, "B") ورقة3.Cells(Lrow, "D") = ورقة1.Cells(29, "D") ورقة3.Cells(Lrow, "E") = ورقة1.Cells(29, "F") ورقة3.Cells(Lrow, "F") = ورقة1.Cells(30, "F") ورقة3.Cells(Lrow, "G") = ورقة1.Cells(31, "F") ورقة3.Cells(Lrow, "H") = ورقة1.Cells(32, "F") ورقة3.Cells(Lrow, "I") = ورقة1.Cells(33, "F") Dim LastRow As Integer Dim R As Integer For R = 7 To 27 If (ورقة1.Cells(R, "b") = "") Then Exit Sub End If LastRow = ورقة2.Cells(ورقة2.Rows.Count, "A").End(xlUp).Offset(1, 0).Row ورقة2.Cells(LastRow, "A") = ورقة1.Cells(2, "B") ورقة2.Cells(LastRow, "B") = ورقة1.Cells(3, "B") ورقة2.Cells(LastRow, "C") = ورقة1.Cells(4, "B") ورقة2.Cells(LastRow, "D") = ورقة1.Cells(R, "B") ورقة2.Cells(LastRow, "E") = ورقة1.Cells(R, "C") ورقة2.Cells(LastRow, "F") = ورقة1.Cells(R, "D") ورقة2.Cells(LastRow, "G") = ورقة1.Cells(R, "E") ورقة2.Cells(LastRow, "H") = ورقة1.Cells(R, "F") Next ورقة1.Cells(2, "B") = "" ورقة1.Cells(3, "B") = "" ورقة1.Cells(4, "B") = "" ورقة1.Cells(R, "B") = "" ورقة1.Cells(R, "C") = "" ورقة1.Cells(R, "D") = "" ورقة1.Cells(R, "E") = "" ورقة1.Cells(R, "F") = "" End Sub

لعل هذا يكون المطلوب ضع اى اضافة ما دامت ممكنه سيتم التعديل datea.xlsx

ارسل تصور للنتائج تم عمل تقرير Pivot Tabels عمود id_Ccallg اساس وشرط العد لكل الاعمده عد وليس جمع القيم

لعل هذا يكون المطلوب المصنف1.xlsx

السلام عليكم ورحمة الله وبركاته الفورم به استدعاء للصوره من اى مسار فهل يمكن تغيير المسار وحفظ الصورة فى مسار اخر المصنف1.xlsb

اخى ضاحى احسنت بارك الله فيكم

اخى وجيه اكرمكم الله ونفع بكم

اخى الحبيب ضاحى جزاكم الله خير وجعله الله فى ميزان حسناتك اود الاستفاده من طريقة كتابتك للاكواد اخى الحبيب مع ان الكنترول 1 2 3 4 الى انك اخترت فى الحلقة التكراريه من 0 1 2 3 واعلم انك اضفت واحد +1 لما لم تستخدم من 4:1 حاولت اعطتنى خطا For AddEvent = 0 To 3 Set LblEvent(AddEvent).LblBtn = Me("Btn" & AddEvent + 1) Next AddEvent لا اجد فى الكود ما يخفى اسماء التبويبات رغم انها تظهر فى التصميم ولا تظهر فى التشغيل page1 page2 page3 page4

اخى ضاحى ممتاز وبارك الله فيك صيغ الصور بحيث لا تزيد مساحة البرنامج فى حالة وجود اكثر من فورم وافضل برنامج لتصميم صور للفورم جزاك الله خيرا