عبدالله باقشير

السلام عليكم تم اضافة بعض التعديلات Option Explicit Sub collect_data() On Error Resume Next Dim rep_N Dim wo As Workbook Dim sn As String, a As String, z As String, x As String, sign As String Dim i As Integer Dim rr As Long, j As Long, k As Long Set wo = ActiveWorkbook sn = ActiveSheet.Name rep_N = InputBox("Number of Reports from 001 to ?", wo.Name) Application.ScreenUpdating = False For i = 1 To rep_N k = wo.Worksheets(sn).Range("A1000").End(xlUp).Row + 2 z = ActiveWorkbook.Path & "\" & "R00" & i & "\" x = "Report" & Format(i, "00#") & ".xls" a = z & x If Workbook_Exists(z, x) Then Workbooks.Open Filename:=a Sheets(1).Select sign = [c1000].End(xlUp).Value With Range([a3], [a3].End(xlToRight).End(xlDown)) rr = .Rows.Count .Copy (wo.Worksheets(sn).Cells(k, "A")) End With wo.Worksheets(sn).Cells(k, "D").Resize(rr, 1).Value = sign Workbooks(x).Close False End If Next i Application.ScreenUpdating = True Set wo = Nothing On Error GoTo 0 End Sub -------------------------------------------------------------------------- Option Explicit Function Workbook_Exists(FilePath As String, Filename As String) As Boolean With Application.FileSearch .LookIn = FilePath .Filename = Filename Workbook_Exists = .Execute > 0 End With End Function ممكن تستدعي البيانات من اي ملف موجود فيه الكود ActiveWorkbook واي ورقة في الملف ActiveSheet تفضل المرفق Salary.rar

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

السلام عليكم تمت بعض التعديلات في الكود : Sub collect_data() Dim a, x, rep_N rep_N = InputBox("Number of Reports from 001 to ?") Application.ScreenUpdating = False For I = 1 To rep_N x = "Report" & Format(I, "00#") & ".xls" a = ActiveWorkbook.Path & "\" & "R00" & I & "\" & x Workbooks.Open Filename:=a Sheets(1).Select sign = [c1000].End(xlUp).Value Range([a3], [a3].End(xlToRight).End(xlDown)).Select rr = Selection.Rows.Count Selection.Copy Workbooks("Sal.xls").Activate Sheets(2).Select [A10000].End(xlUp).Offset(2, 0).Select ActiveSheet.Paste ActiveCell.Select For j = 1 To rr Selection.Offset(j - 1, 3) = sign Next j Application.CutCopyMode = False Windows(x).Close False Next I Application.ScreenUpdating = True End Sub خبور خير

السلام عليكم =========== الاخ الفاضل /هشام شلبي __________حفظه الله ولك بمثل دعائك اضعاف مضاعفة اكرمك الله وكل عام وانت بخير تقبل تحياتي وشكري خبور خير

السلام عليكم اذاكانت كل الملفات في نفس الفولدر مع الملف SAL غير السطر 5 من الكود بهذا Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & a خبور خير

السلام عليكم الاخ الفاضل/ الخالدي _________حفظه الله الاخ الفاضل/ هشام شلبي _________حفظه الله الاخ الفاضل/ كيماس _________حفظه الله بارك الله فيكم جميعاً تقبلوا تحياتي وشكري ======================================== الاخ الفاضل/ office2003_________حفظه الله يجب ان تراعي ان تكون اسماء الاوراق مطابقة للاسماء في كود المسح kh_ClearContents السطر 3 Sub kh_ClearContents(Optional kh_Msg As Boolean = False) Dim L As Integer Kh_Sh_N = Array("اتصالات", "فودافون", "موبينيل") For Each N In Kh_Sh_N If SheetExists(CStr(N)) Then With Worksheets(N) .Columns(1).ClearContents L = .UsedRange.Rows.Count .Range("B4:F" & L).ClearContents End With End If Next N If kh_Msg Then MsgBox " لقد تم المسح بنجاح ", vbExclamation + vbMsgBoxRight, "الحمدلله " End Sub في كود الدالة Kh_Sh_Name السطر 4 Function Kh_Sh_Name(Num) As String Dim sn, Ln Dim R As Byte sn = Array("فودافون", "فودافون", "فودافون", "موبينيل", "موبينيل", "موبينيل", "اتصالات", "اتصالات") Ln = Array("010", "016", "019", "012", "017", "018", "011", "014") Kh_Sh_Name = "" For R = 0 To 7 If Ln(R) = Left(Num, 3) Then Kh_Sh_Name = sn(R) Exit For End If Next End Function ودمتم في حفظ الله kh_Test.rar

السلام عليكم if الشرط then جواب الشرط else عكس جواب الشرط انا اريد عكس جواب الشرط احيانا في بعض الاكواد ( ليس في كودنا هذا ) لا تجد الا شرطا واحدا ولكنك تريد عكسه فممكن استخدام الجملة اعلاة وايضا يمكنك استخدام التعبير التالي: ================================================================== الارتفاع الافتراضي هو 18 والعرض الافتراضي هو 72 انا لم اذكر الارتفاع لانني اريد القيمة الافتراضية شاهد المرفق فيديو يوضح القيمة الافتراضية اثناء الاضافة خبور خير Add_le.rar

SUBTOTAL إرجاع مجموع فرعي في إحدى القوائم أو قواعد البيانات. بوجه عام، من السهل إنشاء قائمة بمجموع فرعي باستخدام مجاميع فرعية (القائمة بيانات بمجرد إنشاء قائمة المجموع الفرعي، يمكنك تعديلها بواسطة تحرير الدالة SUBTOTAL. بناء الجملة SUBTOTAL(function_num, ref1, ref2, ...) Function_num (رقم الدالة) الأرقام من 1 إلى 11 (بما في ذلك القيم المخفية) أو 101 إلى 111 (تجاهل القيم المخفية) والتي تحدد الدالة التي تستخدم في حساب المجاميع الفرعية داخل القائمة. تجاهل القيم المخفية (بما في ذلك القيم المخفية) (الدالة) AVERAGE 1 101 COUNT 2 102 COUNTA 3 103 MAX 4 104 MIN 5 105 PRODUCT 6 106 STDEV 7 107 STDEVP 8 108 SUM 9 109 VAR 10 110 VARP 11 111 هي النطاقات أو المراجع من 1 إلى 29 التي تريد المجموع الفرعي لها. ملاحظات إذا كان هناك مجاميع فرعية أخرى داخل ref1, ref2, (أو مجاميع فرعية متداخلة)، يتم تجاهل المجاميع الفرعية المتداخلة هذه لكي يتم تجنب العد المزدوج. بالنسبة لثوابت function_num من 1 إلى 11، تتضمن الدالة SUBTOTAL قيم الصفوف المخفية بواسطة الأمر إخفاء تحت القائمة الفرعية صف في القائمة تنسيق). استخدم هذه الثوابت عندما تريد للمجموع الفرعي ارقام مخفية وغير مخفية في القائمة. بالنسبة لثوابت function_Num من 10 إلى 11، تتجاهل دالة SUBTOTAL قيم الصفوف المخفية بواسطة الأمر إخفاء في القائمة الفرعية صف من القائمة تنسيق). استخدم هذه الثوابت عندما تريد المجموع الفرعي للأرقام المخفية في القائمة. تتجاهل الدالة SUBTOTAL اية صفوف غير مضمنة في ناتج التصفية، بغض النظر عن قيمة function_num التي تستخدمها. تم تصميم الدالة SUBTOTAL لاعمدة البيانات، أو النطاقات الرأسية. ولم يتم تصميمها لصفوف البيانات، أو النطاقات الأفقية. على سبيل المثال، عند حساب المجموع الفرعي لنطاقات أفقية باستخدام function_num لـ 101 أو أكبر، بالشكل SUBTOTAL(109,B2:G2)، لا يؤثر إخفاء أحد الأعمدة على المجموع الفرعي، ولكن يؤثر إخفاء أي من الصفوف في النطاق الرأسي على المجموع الفرعي. إذا كانت أي من المراجع عبارة عن مراجع ثلاثية الأبعاد، تقوم SUBTOTAL بإرجاع القيمة الخطأ !VALUE#.

السلام عليكم لقد اشتغلت في الملف قليلا ولم اكمله بعد لقد عملت دالة لمعرفة الرقم لاي شركة لكي استخدمها في كود الترحيل وقد قمت بالترحيل فعلا ولكن الى العمود الاول تباعا والفكرة لم تاتي بعد كيف سيتم توزيعة بالشكل الذي تريده ودمتم في حفظ الله خبور خير Test2003.rar

في ورقة مثال2 افتح الفورم وشاهده ثم اعمل شرطة امام هذا السطر حتى لا يستخدم في الكود وافتح الفورم مره اخرى ستجد ان حدود الفرمة موجودة هذا السطر من الكود يقوم بعدم اظهارها هذه من النواحي الجمالية ثانيا لماذا وضعنا هذه المتغيرات هنا Option Explicit Private lcol As Integer Private k As Integer اولا عندما نستخدم Option Explicit في اي وحدة نمطية يجب ان نصرح على جميع المتغيرات فيها (dim , public ,private.....الخ) وعندما نجعلها في بداية الوحدة النمطية لن نعيد تكرارالتصريح عنها في اي كود من اكواد الوحدة النمطية نفسها ولكن ممكن نعيد ربطها بالقيمة مرة اخرى بسبب تغير هذه القيمة ومثال على ذلك المتغير k ولكن المتغير lcol قمنا بربطة بالقيمة في الكود الافتتاحي للفورم وقمنا باستخدامة في باقي الاكواد بدون اعادة ربطه بالقيمة

الشكر واصل لجميع المشاركين حفظكم الله ورعاكم خبور خير

السلام عليكم الاخت الفاضلة ايناس __________ حفظها الله رمضان كريم وكل عام وأنت بألف خير جزاك الله خبرا شكرا جزيلا ------------------------------ شاهد المرفق بثلاثة امثلة للبيانات باعمدة مختلفة وقد قمت ببعض التعديلات في الكود ليفهم سريعا خبور خير الديناميكى التام لاستعراض السجل وحفظ التغييرات مع الفريم1.rar

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

======================== الاخ الفاضل / كيماس ======================== و

السلام عليكم شاهد الملفين في المرفق التالي ايهما افضل لقد قمت بعملهما من سابق وهما لاضافة اوراق المصنف لفورم خبور خير اضافة اسماء الاوراق الى فورم.rar

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

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

المعادلة: =SUBTOTAL(3;$B$6:B8) ستعطيك تسلسل تلقائي من العدد واحد اثناء الفلترة علشان يظهر التسلسل في التقرير بشكل مرتب من 1 الى آخر رقم

السلام عليكم الاخ الفاضل امير __________حفظه الله الاخ الفاضل هشام شلبي __________حفظه الله الاخ الفاضل ناصر __________حفظه الله لكم بمثل دعائكم اضعاف مضاعفة بارك الله فيكم تقبلوا تحياتي وشكري الاخ الفاضل كيماس __________حفظه الله ستجد الشرح على الرابط http://www.officena.net/ib/index.php?showtopic=33625 خبور خير

السلام عليكم شرح لكيفية اضافة عناصر الى فورم Private Sub UserForm_Initialize() Dim MyOptionButton As Control Dim MyTop As Integer, i As Integer ' اول توب للاضافة MyTop = 18 For i = 1 To 5 ' اضافة شيك بوكس بعدد السلسلة في المتغير ' i Set MyOptionButton = Me.Controls.Add("Forms.OptionButton.1") With MyOptionButton ' اين يوضع الشيك بوتن ' '.Move Left, Top, witdh, Height .Move 18, MyTop 'موقع التشييك باليمين .Alignment = 0 'اللون .BackColor = &HFFC0C0 'عرض الخط .Font.Bold = True 'ما يكتب عليه .Caption = "خبور " & i 'الكتابة من اليمين .TextAlign = fmTextAlignRight 'يشيك الشيك بوتن i=1 اذا كانت If i = 1 Then .Value = True End With 'يتغير الموقع بمقدار 30 MyTop = MyTop + 30 Next End Sub في المرفق مثالين لذلك مع الشرح داخل الكود تقبلوا تحياتي وشكري Add_Controls.rar

السلام عليكم const هو عبارة عن ثابت خاص بالمستخدم const اسم الثابت as نمط البيانات = تعبير Const iRow As Integer = 4 يحب الانتباه للتالي: 1 -- لا يمكن ان يكون عرضا ونمطا خاصا بالمستخدم 2 -- لا يمكن ان يكون تابعا معرفا من قبل المستخدم او تابعا محجوزا في Visual Basic

اعداد كشوفات مدرسية باختيار روؤس الاعمدة عن طريق فورم بطريقة ابسط للفهم وسهولة نقلها الى اي ملف مع تضبيط الطباعة مع الشرح اعداد كشوفات مدرسية باكواد سهلة التغيير والتي تجعل استخدامه ونقلة الى ملف آخر للعمل عليه بشكل مبسط وتتم التغييرات في مكان واحد في اول الكود هنا : '====================================================== ' اول صف للتقرير Private Const iRow As Integer = 4 '------------------------------------------------------ ' اسم ورقة التقارير Private Const Sh_Report As String = "التقرير" '------------------------------------------------------ ' اسم ورقة البيانات Private Const Sh_MyDate As String = "بيانات اساسية" '------------------------------------------------------ ' تعيين نطاق الخلايا في ورقة البيانات ' ويشمل رؤوس الاعمدة Private Const MyRng_MyDate As String = "A5:X1000" '====================================================== ويمكن يستخدم لاي كشوفات وتقارير او غيره و ساقوم بشرح هذا العمل على شكل دفعات رويدا رويدا وسوف نبدأ اليوم بارفاق الملف وسيتبعه الشرح ان شاء الله خبور خير اعداد تقارير مدرسية.rar

السلام عليكم الاخ الفاضل/ khhanna-------- حفظه الله بارك الله فيك وجزاك الله خيرا تقبل شكري وتقديري ============================= الاخ الحبيب/ محمدي-------- حفظه الله بارك الله فيك وجزاك الله خيرا تقبل شكري وتقديري ============================= الاخ الفاضل/ كيماس-------- حفظه الله ما هي الجزئية الني تريد شرحها في الكود ؟ تقبل شكري وتقديري ============================= الاخ الحبيب/ الحسامي-------- حفظه الله بارك الله فيك وجزاك الله خيرا تقبل شكري وتقديري خبور خير

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