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

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

Sub PrintSpecificPagesInActiveSheet() Dim Arr, SH As Worksheet, Rng As Range, Cell As Range, I As Long Set SH = ActiveSheet With SH ReDim Arr(0 To .HPageBreaks.Count + 1) If Len(.PageSetup.PrintTitleRows) Then Set Rng = .Range(.PageSetup.PrintTitleRows) Arr(0) = Rng.Rows(Rng.Row + Rng.Rows.Count).Row Else Arr(0) = 1 End If For I = 1 To .HPageBreaks.Count Arr(I) = .HPageBreaks(I).Location.Row Next I Arr(UBound(Arr)) = .Cells.SpecialCells(xlCellTypeLastCell).Row + 1 For I = (LBound(Arr) + 1) To UBound(Arr) Set Rng = Intersect(.Rows(Arr(I - 1) & ":" & (Arr(I) - 1)), .UsedRange, .Columns("G")) If Not Rng Is Nothing Then Debug.Print Rng.Address For Each Cell In Rng If Cell.Value > 0 Then .PrintOut From:=I, To:=I Exit For End If Next Cell End If Next I End With End Sub أخي الكريم محمد فؤاد أعتقد أن الموضوع قد تم طرحه من قبل من فترة .. وها أنت تعيد طرحه مرة أخرى (مخالفة لتوجيهات المنتدى) عموماً لا عليك .. جرب الكود التالي عله يفي بالغرض Print Specific Pages On Condition Column G Has Value YasserKhalil.rar

أخي وحبيبي في الله ياسر العربي لقد أبدعت في هذا الموضوع بشكل كبير جداً .. وطرحك في منتهى الروعة والموضو متميز ومفيد وبحمد الله وتوفيقه قمت بتغطيته بشكل ممتاز .. ولكن اسمح لي ببعض الملحوززات الصغيرة جداً .. قد لا تهم الكثيرين ولكن تهمني أولاً يجب مراعاة بدء انتشار التعامل مع 64 بت ..فمتنساش إخوانك الذين لديهم ويندوز 64 بت وأوفيس 64 بت في الفورم قم باستبدال أسطر الإعلان بهذه الأسطر ليتوافق مع 32 بت و64 بت #If VBA7 Then Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare PtrSafe Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long Private Declare PtrSafe Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare PtrSafe Function DrawMenuBar Lib "User32" (ByVal hwnd As LongPtr) As Long #Else Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long #End If ثانياً أحب التخلص من الزيادات الغير مرغوب فيها فمثلا يوجد موديول 1 فيه أمر بإظهار الفورم 1 ، ولا وجود للفورم ومن ثم لا داعي للموديول (راعي أن هناك من يقتبس وفقط .. بالتالي ستكون زيادة ليس لها داعي) ثالثاً : في كود زر الامر دخول CommandButton1 قمت بوضع السطر التالي If Application.WorksheetFunction.VLookup(ComboBox1.Value, Users.Range("A2:B50"), 2, 0) = TextBox1.Text Then في المرفق الخاص بك جعلت النطاق L50 (لما قمت بتوسيع النطاق بهذا الشكل ؟ لما لم تكتفي بالعمودين اللذين بهما أسماء المستخدمين وكلمات السر رابعاً : حاول استخدام برنامج يقوم بضبط أسطر الكود ليسهل الإطلاع عليه خامساً : لا يسعني إلا أن أقول لك جزيت خيراً .. جزيت خيراً .. جزيت خيراً .. فوالله إن الموضوع رائع وجد مفيد ومتميز وما أردت إلا النقد البناء الذي يسهم في علو شأن الموضوع لا أن أبخسه حقه تقبل وافر تقديري واحترامي

جرب السطر بهذا الشكل (يوجد حرف خطأ) LR = .Cells(.Rows.Count, 2).End(xlUp).Row

أخي الكريم مختار ننتظر رد الأخ أبو يوسف ليتضح الأمر أكثر قبل الخوض في غمار التخمين .........!

ملف رائع أخي الغالي عبد العزيز لا حرمنا الله من إبداعاتك المتميزة والمميزة والفريدة

نعم أخي يمكن اعمل كليك يمين على ورقة العمل المطلوب العمل عليها ثم ضع الكود التالي Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) UserForm1.Show End Sub UserForm As Keybad YasserKhalil.rar

قاعدة بيانات عسكرية HaNcOcK Version 3.rar

أخي الكريم سابيك ..أعتقد أنه تم التنويه من قبل بتغيير اسم الظهور للغة العربية فيرجى الالتزام بالتعليمات إليك الملف التالي - بعد إذن أخي وحبيبي في الله - ياسر العربي ...عله يفي بالغرض UserForm As Keybad YasserKhalil.rar

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

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

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

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

يرجى أخي الكريم صالح رفع الملف مرة أخرى

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

Sub CollectDataFromMultipleWorkbooks() Dim OpenFiles Dim crntfile As Workbook Set crntfile = Application.ActiveWorkbook Dim X As Integer Dim SH As Worksheet Dim Arr, Temp, I As Long, J As Long On Error GoTo ErrHandler Application.ScreenUpdating = False OpenFiles = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files (*.csv;*.xlsx;.xlsm),*.csv;*.xlsx;*.xlsm", MultiSelect:=True, Title:="Select Excel File To Merge!") If TypeName(OpenFiles) = "Boolean" Then MsgBox "You Need To Select At Least One File" GoTo ExitHandler End If X = 1 While X <= UBound(OpenFiles) Workbooks.Open Filename:=OpenFiles(X) Sheets().Move After:=crntfile.Sheets(crntfile.Sheets.Count) X = X + 1 Wend Sheets("Master").Activate For Each SH In ThisWorkbook.Sheets With SH If .Name <> "Master" Then Arr = .Range("A1").CurrentRegion.Value For I = 1 To UBound(Arr) Temp = Split(Arr(I, 1), ";") For J = 1 To UBound(Temp) .Cells(I, J) = Temp(J) Next J Next I .Range("A1").CurrentRegion.Columns.EntireColumn.AutoFit End If End With Next SH ExitHandler: Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox Err.Description Resume ExitHandler End Sub أخي الحبيب مختار بارك الله فيك على الكود الرائع الذي قدمته لنا على طبق من ذهب أخي الكريم صاحب الموضوع ..يرجى تغيير اسم الظهور للغة العربية (راجع التوجيهات في الموضوعات المثبتة في المنتدى) جرب الملف التالي بعد إضافة بسيطة لكود الأخ المتميز مختار ليقوم بفصل العمود الواحد لعدة أعمدة تقبل تحياتي Collect Data From Multiple CSV Workbooks Mokhtar V1.rar

أخي الكريم هاني شفاكم الله وعافاكم .. لا بأس طهور إن شاء الله سأبدأ بتناول ما طلبته نقطة نقطة حيث أنني أتوه في كثرة النقاط .. أولاً فيما يخص اختيار الطابعة ..هذا أمر لا بأس به ، ولكن إذا كانت الطباعة من طابعة محددة فأفضل عدم الاختيار في هذه الحالة ، واللجوء مباشرةً من خلال الكود للطباعة لمعرفة الطابعة ..قم أولاً من خلال لوحة التحكم بالدخول على Printers ثم كليك يمين على الطابعة المراد الطباعة من خلالها ثم اختر Set As default (هذا الإجراء بشكل مبدئي فقط ..لمعرفة نوع الطابعة والبورت الموصل بها ...أي أنه يمكنك بعد ذلك تغيير الطابعة الافتراضية .. أي أن هذه الخطوة لمعرفة نوع الطابعة والبورت الموصل بها) المهم ..بعد تلك الخطوة قم بفتح ملف إكسيل ونفذ السطر الذي أشرت إليه من قبل وهو Sub Test() Range("A1").Value = Application.ActivePrinter End Sub سيظهر معك في الخلية A1 اسم الطابعة وفي نهاية اسم الطابعة البورت الموصل بها خذ القيمة في الخلية A1 نسخ ثم قم بوضع السطر التالي في كودك قبل سطر الطباعة مباشرةً Application.ActivePrinter = "اسم الطابعة اللي أخذته نسخ ما بين أقواس تنصيص" يمكنك الذهاب إلى لوحة التحكم ثم Printers مرة أخرى وتغيير الطابعة الافتراضية إلى ما كانت عليه .. لا تشغل بالك السطر الذي أضيف في الكود لا يغير الطابعة الافتراضية ، لا تقلق حيال هذا الأمر ، فقط يغير الطابعة النشطة أي التي ستتم عملية الطباعة من خلالها جرب بنفسك وشوف النتائج *********************** ثانياً : فيما يخص الكود المرفق يتم وضعه في حدث المصنف ThisWorkbook ولكن انتبه أن الكود يضيف كل أوراق العمل الموجودة في المصنف دون استثناء وقمت بتعديل الكود لأن به خطأ بسيط وهو بداية النطاق M2 يجب أن يكون M1 (إلا إذا كانت ورقة العمل Master هي الورقة الرئيسية رقم 1 وتريد عدم إدراجها في القائمة المنسدلة) Private Sub Workbook_Open() Dim WS As Worksheet, LR As Long For Each WS In Sheets Range("M" & WS.Index).Value = WS.Name Next WS Columns("M:M").NumberFormat = ";;;" LR = Sheets("Master").Range("M" & Rows.Count).End(xlUp).Row With Range("N2").Validation .Delete .Add xlValidateList, Formula1:="=M1:M" & LR End With End Sub طبعاً الكود يقوم بعمل حلقة تكرارية لكل أوراق العمل في المصنف ثم يعتمد على رقم الفهرس لكل ورقة عمل ويضيف في العمود M أسماء أوراق العمل ، ثم من خلال الكود يتم إدراج هذه الأسماء في القائمة المنسدلة في الخلية N2 ... *********************** ثالثاً : ارفق ملفك الأصلي وعدد أوراق العمل فيه أو أمر آخر يمكنك إدراج كل أوراق العمل في هذه القائمة إلا ما تقوم باستثنائه أي اذكر لنا أسماء أوراق العمل المراد عدم التعامل معها من خلال المصفوفة لكي يتم تجنبها رابعاً أفضل دائماً التعامل في الموضوعات تناول نقطة نقطة لكي يتم التعامل مع الموضوع بشكل يسهل التعامل معه تقبل تحياتي

الحمد لله الذي بنعمته تتم الصالحات تقبل تحياتي

اتفضل الملف المرفق ..عشان خاطر عيونك بس Alaa YasserKhalil.rar

قلت لك على الخطأ قبل ما يحصل وقلت لك تعمل ايه ..!!

أخي الكريم أبو آلاء أيها العضو الذهبي جرب المعادلة التالية في الخلية B5 =INDEX(N9:N200,MATCH(1,(SUBTOTAL(3,OFFSET(N9:N200,ROW(N9:N200)-MIN(ROW(N9:N200)),0,1)))*(N9:N200<>""),0)) المعادلة معادلة صفيف .. أي أنه يجب الضغط على ثلاثة مفاتيح معاً ..بعد إدخال المعادلة Ctrl + Shift + Enter .. إذا لم تعمل معك المعادلة قم باستبدال الفاصلة الموجودة بفاصلة منقوطة

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

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

ممكن ترفق لنا الملف الأصلي والملف التنفيذي ... للإطلاع عليهما هل وضعت الكود في حدث المصنف ..؟؟

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