saad abed

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

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

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

السلام عليكم يفضل اضافة سطر لمسح الداتا 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

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

الاستاذ محمد اشكرك كل الشكر فقد وصلت المعلومه .End(Direction) xlToLeft = 1 xlToRight = 2 xlUp = 3 xlDown = 4 وفعلا رقم 2 تعبر عن cells(2,1) فهل هناك ارقام اخرى لتغيير الخلايا اشكرك اخى محمد

السلام عليكم اريد ان اعرف وظيفة الارقام فى الكود التالى Worksheets(WS.Name).Cells(Rows.Count, 1).End(3)(2) هل رقم 3 بديل xlup ورقم 2

استاذ سليم اكوادك رائعة وفيها ابداعات جزاك الله خيرا

اخوتى الاعزاء بعد اعادة انشاء الملف الافتراضى فى المسار C:\Users\saadabed\AppData\Local\Temp\Rar$DIa3740.16254 افتح الاكسيس مره او اكثر لاجد اختفاء ملفRar$DIa3740.16254 واضطر لانشاءه مره اخرى فهل هناك من حل

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

السلام عليكم تظهر لدى رساله فى بداية تشغيل الاكسيس مكونه من سطرين تعذر على ميكرسوفت اكسيس تغيير دليل العمل الى مسار temp تاكد من انك تستخدم محرك الاقراص الصحيح وان طول المسار هو 260 حرف او اقل عملت رفع للاوفيس 2016 وتم عمل ستب ولا فائده علما لو وافقت على الرساله يعمل البرنامج كل الملفات اى كان موقعها على الجهاز

استاذ سليم كل الشكر والتقدير وصلت المعلومه واكتملت الفكره اشكرك اشكرك

استاذى الفاضل سليم اسال الله ان يجزيك خيرا على الابداعات التى تقدمها اكاد افهم اليه الكود باستثناء طريقة الجمع فى الكود ما افهمه من الكود الاعلان عن المتغيرات Dim Rg_A As Range Dim Rg_D As Range, Rg_G As Range Dim a%, d%, g%, X% Dim St1$, St2$ Dim Dic As Object ثم مسح مكان استدعاء البيانات Range("k3").CurrentRegion.ClearContents ثم تعيين المتغيرات وتعريفها Set Rg_A = Range("A3", Range("A2").End(4)) Set Rg_D = Range("D3", Range("D2").End(4)) Set Rg_G = Range("G3", Range("G2").End(4)) a = Rg_A.Rows.Count: d = Rg_D.Rows.Count g = Rg_G.Rows.Count St1 = "All Products": St2 = "All Volume" Set Dic = CreateObject("Scripting.dictionary") ثم عمل ثلاث حلقات تكراريه تبدا من الصف الثالث الى عدد صفوف الرنج المشار اليه بالحلقه For X = 3 To a - 2 If Not Dic.exists(Cells(X, 1).Value) Then Dic(Cells(X, 1).Value) = Cells(X, 2) Else Dic(Cells(X, 1).Value) = Dic(Cells(X, 1).Value) + Cells(X, 2) End If Next ما افهمه من الحلقه التكراريه اذا لم تجد عنصر الكائن اى عدم تكراره فى الرنج فانه يساوى cells(x,2 والا اللى انا فهمه اجمع العنصر بالرقم المجاور ارجو شرح هذه الجزئية اشكرك الباقى واضح