نجوم المشاركات

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله استناداً إلى الموضوع في الرابط التالي من هنا قمت بتطوير كود بحيث يمنع التكرار في العمود الأول ، وفي نفس الوقت يسمح للنسخ لخلية واحدة فقط ، أما إذا تم النسخ لأكثر من خلية فإنه يتم التراجع عن الأمر ومسح الخلايا المنسوخة ها هو الكود يوضع في حدث ورقة العمل ، ويتم التعامل مع العمود الأول Private Sub Worksheet_Change(ByVal Target As Range) Dim Cl As Variant, Dat As Variant Dim DupCtr As Double Dim LastRow As Long If Not Application.Intersect(Target, Columns("A:A")) Is Nothing Then Application.EnableEvents = False If Target.Cells.Count > 1 Then Dat = Target.Formula For Each Cl In Dat If Cl <> "" Then MsgBox "Change Only One Cell At A Time", , "Too Many Changes!" Application.Undo: Application.CutCopyMode = False GoTo Skipper End If Next Cl End If '========================================================================= LastRow = Cells(Rows.Count, "A").End(xlUp).Row DupCtr = Application.WorksheetFunction.CountIf(Range(Cells(1, "A"), Cells(LastRow, "A")), Target.Text) If DupCtr > 1 Then MsgBox "You Have Entered A Duplicate" Target.ClearContents: Target.Activate GoTo Skipper End If End If Skipper: Application.EnableEvents = True End Sub أرجو أن يكون الموضوع مفيد لكم حمل الملف من هنا تقبلوا وافر تقديري واحترامي

السلام عليكم ورحمة الله وبركاته إخوتي الكرام:عمالقة وعباقرة المنتدى الكريم تساءلت عن مرونة جدول في ورقة محمية ...لنزيد صفوفه حسب الحاجة وتداولت موضوعه مع بعض الأصدقاء لأنه وكما تعلمون أنه عند نهاية الجدول في ورقة غير محمية نقوم بالمفتاح Tab بفتح صف جديد ...فهو هنا مرن وجميل وخصوصاً أن استخدامات الجداول أكثر لياقة في مجالات الفرز والتصفية والبحث ...إلخ. وبعد البحث والاستعانة بالخبرات توصلت إلى الكودين التاليين : Private Sub Worksheet_Change(ByVal Target As Range) Dim n As Integer n = Cells(Rows.Count, 3).End(xlUp).Row If Target.Column = 5 And Target.Row = n Then With ActiveSheet .Unprotect "1" .ListObjects(1).Resize Range("$C$4:$E$" & n + 1) .Protect "1" End With End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim n As Integer n = Cells(Rows.Count, 3).End(xlUp).Row + 1 If Target.Column = 3 And Target.Row = n Then With ActiveSheet .Unprotect "1" .ListObjects("Table1").Resize Range("$C$4:$E$" & n) .Protect "1" End With End If End Sub حيث تتم زيادة الصفوف بالمفتاح Tab عندما تكون الصفوف أسفله لم يتم تأمينها...أما إن كانت الخلايا مؤمنة فإنه يتم نقر الماوس تحت أول عمود من الجدول ليفتح صفاً جديداً... ورغبة مني بإثرائكم للموضوع من ناحية مرونة الجدول بإضافة أعمدة أو صفوف حال الحماية فإنني أضعه بين أيديكم الكريمة لينال حقه الوافي من الدراسة....والسلام عليكم ورحمة الله وبركاته. ملاحظة:للأمانة العلمية..الأكواد والملف المرفق منقولة . وبما أن العمل على ورقة محمية رمز الحماية:1 Add row to table.rar

أخي الكريم أسامة كليك يمين على اسم ورقة العمل ثم View Code ثم ضع الكود التالي عله يفي بالغرض Private Sub Worksheet_Change(ByVal Target As Range) Dim DupCtr As Double LastRow = Cells(Rows.Count, "A").End(xlUp).Row If Not Intersect(Target, Columns(1)) Is Nothing Then DupCtr = Application.WorksheetFunction.CountIf(Range(Cells(1, "A"), Cells(LastRow, "A")), Target.Text) If DupCtr > 1 Then MsgBox "You Have Entered A Duplicate" Target.ClearContents End If End If End Sub

الحمد لله الذي لولاه ما جرى قلم, و لا تكلم لسان, و الصلاة و السلام على سيدنا محمد (صلى الله عليه و سلم) كان أفصح الناس لساناً و أوضحهم بياناً. من دواعي سروري أن أشرح هذا الموضوع الهام في علم التكنولوجيا, و أرجو من الله تعالى أن يحوز على اعجابكم, و هو شرح لأهم برنامج من برامج الاوفيس برنامج (مايكروسوفت أكسيس 2013). و اهدي هذا العمل الى والداي رحمهم الله و تغمدهم برحمته أرجو منكم الدعاء لهما. منهاج مايكروسوفت أكسيس 2013 و هو منهاج خاص من شركة مايكروسوفت و يغطي خاصة منهاج الفحص الخاص بشهادة MOS (Microsoft Office Specialist) مع ملاحظة أن المنهاج ليس ترجمة بل شرح خاص حسب خبرتي الخاصة بهذا البرنامج. سأقوم بنشر هذا الكتاب على مراحل ستكون عبارة عن مجموعة دروس مصممة بنوعين من الملفات: الملف الأول ملف عرض تقديمي بوربوينت. الملف الثاني ملف من نوع PDF. مدعومين بالصور كأمثلة شرح عن كل فكرة. و سيتم نشر كل خمس أيام درس. و بعد اكتمال جميع الدروس سيتم نشر ملف خاص يحتوي على مثال متكامل يشرح كيفية بناء و إنشاء قاعدة بيانات متكاملة أبدأ فيها من مرحلة التحليل الى مرحلة التصميم النهائية بالتفصيل. أي ملاحظة أو استفسار لديكم الرجاء مراسلتي على بريدي الخاص abdotarakji@gmail.com. -----------------------------------------------------------------------------------------------

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

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

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

السلام عليكم ورحمة الله وبركاته إخواني الكرام في موضوع للأخ الحبيب محمد حسن أبو يوسف ، قمت بعمل تصفية للبيانات بناءً على مربع نص ، إلا أنه في مشاركة للأخ الغالي رشراش علي أن الكود لا بعمل مع الأرقام ولا يعطي نتيجة ، كما أن الأخ أحمد أبو زيزو طلب مني شرح خطوات العمل فيما يتعلق بهذا الموضوع رابط الموضوع وبناءً على طلب إخواني ، وهم يدركون أنني لا أتأخر عليهم أبداً أقدم لكم موضوع اليوم فارتأيت (حلوة ارتأيت دي ... ) أن أخصص موضوع لهذا الأمر ، نظراً للطلب عليه ، ونظراً للفائدة المرجوة منه ، حيث أنه يسهل عملية البحث من خلال تصفية البيانات المطلوبة. يعتمد الملف المرفق على مثال بسيط للتطبيق ، تم إدراج مربع نص TextBox من خلال التبويب Developer ثم من Insert اختر مربع نص TextBox من القسم ActiveX Controls والبيانات المراد التعامل معها تبدأ من الخلية C3 وحتى آخر خلية بها بيانات... إليكم إخواني الكود مع شرح مبسط للأسطر عله يفيدكم Private Sub TextBox1_Change() 'يقوم الكود بالبحث في نطاق من خلال مربع نص ، وتصفية النتائج طبقاً للنص المدخل '[Insert] ثم من قائمة [Developer] من خلال التبويب [TextBox] قم بإدراج مربع نص 'ثم قم بإدراجه على ورقة العمل [ActiveX Controls] قم بالنقر على مربع النص الموجود في '-------------------------------------------------------------------------- 'تعريف المتغيرات والثوابت Dim LastRow As Long, RngFiltered As Range, I As Long, Arr Static Rng As Range 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'إلغاء الفلترة في ورقة العمل النشطة ActiveSheet.AutoFilterMode = False 'قيمة تظهر كل الصفوف لهذا النطاق [Static] إذا لم يكن للثابت المسمى If Not Rng Is Nothing Then Rng.EntireRow.Hidden = False 'تحديد آخر صف به بيانات في العمود الثالث LastRow = Range("C1000").End(xlUp).Row 'أي الخلية التي تسبق أول البيانات [C2] تعيين قيمة النطاق بداية من الخلية Set Rng = Range("C2:C" & LastRow) 'تعيين قيمة للمتغير من النوع مصفوفة ليساوي كل قيم النطاق Arr = Rng.Value 'إذا كان طول السلسلة النصية في مربع النص أكبر من صفر If Len(TextBox1.Text) > Then 'حلقة تكرارية لصفوف النطاق For I = 1 To UBound(Arr, 1) '[']إذا كان العنصر داخل المصفوفة رقمي يتم وضع علامة If IsNumeric(Arr(I, 1)) Then Arr(I, 1) = "'" & Arr(I, 1) Next I 'قيم النطاق تساوي القيم الجديدة في المصفوفة Rng.Value = Arr 'تصفية النطاق بشرط النص المدخل في مربع النص Rng.AutoFilter Field:=1, Criteria1:="=" & TextBox1.Text & "*" End If 'تعيين المتغير ليساوي الخلايا الظاهرة في النطاق Set RngFiltered = Rng.SpecialCells(xlCellTypeVisible) 'إلغاء الفلترة في ورقة العمل النشطة ActiveSheet.AutoFilterMode = False 'حلقة تكرارية لإعادة الأرقام للحالة الأولى بدون العلامة البادئة For I = 1 To UBound(Arr, 1) If Left(Arr(I, 1), 1) = "'" Then Arr(I, 1) = Mid(Arr(I, 1), 2) End If Next I Rng.Value = Arr 'إخفاء الصفوف للنطاق Rng.EntireRow.Hidden = True 'إظهار الصفوف للنطاق الذي تمت عملية التصفية على أساسه RngFiltered.EntireRow.Hidden = False 'إعادة تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub أترككم مع الملف المرفق .. قوموا بتجربة الملف .. تم إدراج بيانات مختلفة نصوص باللغة العربية وباللغة الإنجليزية وأرقام ... حمل الملف من هنا تقبلوا تحياتي أخوكم ياسر خليل أبو البراء

نسأل الله العفو والعافية لأختنا الفاضلة أم عبد الله ، فكم تعلمنا منها الكثير غفر الله لنا ولها

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

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

اخي احمد ما رأيك ... عمر الجهاز 2.rar

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

السلام عليكم ورحمة الله وبركاته ...جزاكم الله خيراً أخي الحبيب أبو البراء على هذا الكود الرائع الذي يمنع التكرار في العمودA حيث يعطي رسالة بوجود تكرار معين من خلال استخدام الدالة CountIf ويمسح محتوى الخلية التي حصل بها التكرار. تقبل تحياتي العطرة والسلام عليكم.

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله لطالما أردت طرح هذا الموضوع الهام جداً والشيق جداً والمفيد جداً .. ولكن يبدو أن الزهايمر يلعب دوراً هاماً في حياتي .. عموماً ذكرني عنوان موضوع رأيته الآن بهذا الموضوع ، فأحببت أن أشارككم هذا الكود الرائع والمتميز .. الكود يقوم بالمهام التالية .. في بداية تنفيذ الكود يمكنك الكود من اختيار الطابعة المطلوب الطباعة عليها .. من خلال الصور سأقوم بالطباعة على ملف بامتداد XPS .. حتى لا أهدر أوراقي (سامحوني .. دا مش بخل دا حرص مش كدا ولا ايه يا فلاحجي (لأنه أكتر واحد هيفهمني )) حسناً رأيتم الصورة معبرة ..أليست كذلك؟ نقرنا على زر الأمر PRINT ...فظهرت نافذة تتيح لنا إمكانية اختيار الطابعة ثم نضغط أوك لننتقل للنافذة التالية في النافذة التالية يتيح الكود كتابة عدد النسخ المراد طباعتها وبشكل افتراضي يكون عدد النسخ نسخة واحدة فقط ، ويمكن تغيير عدد النسخ المطلوبة هنا تظهر لك أوراق العمل الموجودة في المصنف عدا ورقة العمل النشطة المسماة Data ، يمكنك الكود من اختيار أوراق العمل المراد طباعتها بكل سهولة ثم أخيراً يتم تنفيذ أمر الطباعة ..في المثال الموضح سأقوم بتنفيذ أمر الطباعة لملف بامتداد XPS .. حيث يتم كتابة اسم الملف وتحديد المسار الذي سيحفظ فيه الملف ثم اوك قمت بتحديد مسار حفظ الملف بامتداد XPS على سطح المكتب وها هو الملف وقد طبع ورقتي العمل Sheet1 و Sheet3 فقط ، لأنني حددتهما من خلال النوافذ التي تظهر وأخيراً إليكم الكود الرائع الذي يقوم بكل هذه المهام الرائعة Sub PrintSelectedSheets() Dim I As Integer Dim TopPos As Integer Dim SheetCount As Integer Dim PrintDlg As DialogSheet Dim CurrentSheet As Worksheet Dim Cb As CheckBox Dim Numcop As Long Dim Cnt As Integer Dim X As String Application.Dialogs(xlDialogPrinterSetup).Show Application.ScreenUpdating = False If ActiveWorkbook.ProtectStructure Then MsgBox "المصنف محمي", vbCritical Exit Sub End If Set CurrentSheet = ActiveSheet X = CurrentSheet.Name Set PrintDlg = ActiveWorkbook.DialogSheets.Add SheetCount = 0 TopPos = 40 For I = 1 To ActiveWorkbook.Worksheets.Count Set CurrentSheet = ActiveWorkbook.Worksheets(I) If Application.CountA(CurrentSheet.Cells) <> 0 And CurrentSheet.Visible Then SheetCount = SheetCount + 1 PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5 PrintDlg.CheckBoxes(SheetCount).Text = CurrentSheet.Name TopPos = TopPos + 13 End If Next I PrintDlg.Buttons.Left = 240 With PrintDlg.DialogFrame .Height = Application.Max(68, PrintDlg.DialogFrame.Top + TopPos - 34) .Width = 230 .Caption = "اختر أوراق العمل المراد طباعتها" End With PrintDlg.Buttons("Button 2").BringToFront PrintDlg.Buttons("Button 3").BringToFront Numcop = Application.InputBox("أدخل عدد النسخ للطباعة:", "كم عدد النسخ?", 1, Type:=1) If Numcop = 0 Then ElseIf Len(Numcop) > 0 Then End If CurrentSheet.Activate Application.ScreenUpdating = True If SheetCount <> 0 Then If PrintDlg.Show Then For Each Cb In PrintDlg.CheckBoxes If Cb.Value = xlOn Then If Cnt = 0 Then Worksheets(Cb.Caption).Select Else Worksheets(Cb.Caption).Select Replace:=False End If Cnt = Cnt + 1 End If Next Cb ActiveWindow.SelectedSheets.PrintOut copies:=Numcop End If Else MsgBox "كل أوراق العمل فارغة", 64 End If Application.DisplayAlerts = False PrintDlg.Delete Sheets(X).Select End Sub تقبلوا جميعاً وافر تقديري واحترامي حمل الملف من هنا تحميلك للملف يدعم صاحب الموضوع .. فلا تبخل بدقيقة من وقتك .. وللعلم يمكنك عدم تحميل الملف ونسخ الكود في موديول في المصنف الخاص بك ، وستجد الكود جاهز للعمل لديك بدون تحميل الملف .. دمتم على طاعة الله ...

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

بسم الله و ما شاء الله اللَّهُمَّ انْفَعْنَا بِمَا عَلَّمْتَنَا , وَعَلِّمْنَا مَا يَنْفَعُنَا , وَزِدْنَا عِلْمًا إِلَى عِلْمِنَا اهداء لكل من شارك بعلمه اقل ما يقال لكم "عندما تنتهى كلمات الابداع عندكم و تبدأ من جديد و تنتهى عندكم" بارك الله لكم مدونة اعمال ايقونات الماس لمنتدى اوفيسنا _ شارك بتعديلاتك فكرة المدونة هى سهولة الوصول و البحث فى المنتدى 1 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_برامج جاهزه ( حسابات_ميزان مراجعه_سندات قبض_يوميه) 2 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_بحث_اضافة_تعديل_ترحيل_ادخال 3 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_اكواد و معادلات و فورم 4 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_شاشة دخول_صلاحيات_PASS WORD 5 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_الاتصالات_الادارية_الموظفين 6 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_كنترول_امتحانات_لجان 7 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_الاكسيل الترفيهي 8 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_الاكسيل الاسلامى و لا تنسونا من صالح الدعاء و لامى بالمغفره و الرحمه

السلام عليكم عيدكم مبارك بالمرفق كود يعرض اسماء اوراق العمل بعد كتابة هذه المعادلة البسيطة في الورقة ()SHNAME = تحياتي عرض اسماء اوراق العمل.rar

السلام عليكم ورحمة الله وبركاته إخواني في الله الموضوع ليس جديد وقد تم طرح الكود في مشاركات فرعية بموضوعات مختلفة بالمنتدى ، ولكن لأهميته رأيت ان أقوم بطرح موضوع مستقل ليسهل الوصول إلى الموضوع باستخدام خاصية البحث في المنتدى فكرة الكود هي استخراج القيم الغير مكررة أي استخراج القيم الفريدة في نطاق محدد .. والكود مشروح لمن أرد الشرح لعل وعسى أن يتعلم الجميع كيفية استخدام الأكواد بشكل جيد وهذا هو الكود مصحوب بالشرح ... أرجو أن ينال إعجايكم Sub UniqueByDictionary() 'يقوم الكود باستخراج القيم الفريدة أي الغير مكررة باستخدام الكائن قاموس '---------------------------------------------------------------------- 'المتغير الأول لتخزين قيم النطاق والمتغير الثاني لتخزين مفاتيح القاموس 'الثالث متغير للكائن القاموس والرابع متغير يستخدم في عمل حلقة تكرارية Dim myData As Variant, Temp As Variant Dim Obj As Object, I As Long 'ليساوي الكائن المسمى القاموس والذي يعتبر أداة قوية للتعامل مع القيم الفريدة [Obj] تعيين المتغير Set Obj = CreateObject("Scripting.Dictionary") 'ليساوي قيم النطاق في العمود الأول [myData] تعيين المتغير myData = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value 'حلقة تكرارية تبدأ من أول عنصر في مصفوفة القيم إلى آخر عنصر في المصفوفة For I = 1 To UBound(myData) 'هذا السطر هو أهم سطر في الكود حيث يتم تمرير القيمة للقاموس 'فيقوم القاموس بتخزينها إذا كانت القيمة تصادفه لأول مرة 'أما إذا كانت القيمة مكررة فلا يقوم بتخزينها مرة أخرى Obj(myData(I, 1) & "") = "" Next I 'ليساوي مفاتيح القاموس والتي تمثل القيم الغير مكررة [Temp] تعيين المتغير Temp = Obj.Keys 'حيث يتم تحديد عدد الصفوف [E1] وضع عناصر القاموس الغير مكررة في الخلية 'والتي تقوم بعد عناصر القاموس التي تم تخزينها [Count] من خلال كلمة 'عبارة عن مصفوفة بالقيم تكون على شكل أفقي لذا نستخدم [Temp] المتغير 'لتحويل القيم من الشكل الأفقي إلى الشكل الرأسي ليناسب وضع النتائج في عمود [Transpose] كلمة Range("C1").Resize(Obj.Count, 1) = Application.Transpose(Temp) End Sub وإليكم الملف المرفق مطبق فيه الكود مع مثال بسيط حمل الملف من هنا تقبلوا تحياتي

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

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

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

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

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

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

السلام عليكم اخي عندي سؤال ما الفرق بين المستخدم والموظف لانه عندك جدولين جدول الموظفين وجدول المستخدمين

ما شاء الله عليك و بارك الله فيك

السلام عليكم - اخباركم استاذ ياسر العربي - ان شاء الله بخير جزيت خيرا اشكرك

اخي كلام الاخ حسين تمام و مية % ... لأنه لا علم لليوزر بهذا الملف المخفي ... و اذا اردت فهذه طريقة ثانية ... تعمل على حفظ رقم المعالج و رقم الماذر بورد في اول تشغيل للبرنامج ( حيث ان قيمة الحقل xxx من الجدول = 1 ) اما التشغيل الثاني و ما بعد فستتم المقارنة ( حيث ان قيمة الحقل xxx من الجدول = 2 ) * يتم ضبط النموذج frm1 بحيث يعمل عند التشغيل . * لم اتمكن من غلق النموذج frm1 عند فتح نموذج الواجهة , لذا ارجوا من احد الاخوة او الاساتذة الكرام عمل ذلك ... My Protect.rar

ابو شهاب لا شكر على واجب ... ان لم تستطع ارفاق البرنامج ... فاعمل مثال مصغر و ارفقه ...

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

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

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

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

أخي الكريم الخلل سببه عدم ضبط نتائج المعادلة لديك حيث يظهر الخطأ NA لديك ولعلاج الخطأ قم بإصلاح المعادلة في الخلية B2 بهذا الشكل =IFERROR(VLOOKUP(A2,السعر,2,FALSE),"") ثم قم بسحب المعادلة ونفذ الكود مرة أخرى ... *********************************** بالنسبة لكود الخلاصة Test قم بتغيير السطر التالي LR = Ws.Cells(Rows.Count, "B").End(xlUp).Row إلى السطر التالي LR = Ws.Cells(54, "B").End(xlUp).Row تقبل تحياتي

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

ما شاء الله عليك تحياتى

بفضل الله وعونه تم الأمر .. لزيارة الموضوع (منع التكرارفي عمود ومنع نسخ أكثر من خلية بالعمود) انقر هنا جزيت خيراً أخي الغالي أبو يوسف على دعواتك الطيبة ، فلولا دعائك ما تم الأمر تقبل تحياتي

=RIGHT(CELL("filename";A2);LEN(CELL("filename";A2))-FIND("]";CELL("filename";A2))) جزاك الله خيرا ويمكن ايضا عن طريق كتابة المعادلة التالية

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

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

تفضل عسى اني توفقت بالمطلوب انتظر ردك Copy of new report2 to osama.rar

جزاك الله خيرا "ياسر خليل " وفقك الله لكل خير

السلام عليكم يبدو و الله اعلم ان هناك شيئ ناقص في مكتبة الكائنات object libiray يمكن الوصول الى هذه المكتبة من القائمة Tools -------> References

اخى الكريم جرب ايضا هذا الكود يفى بالغرض Sub Delete_Zero() Application.ScreenUpdating = False lc = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row For i = lc To 3 Step -1 If Application.WorksheetFunction.Sum(Sheet1.Range(Cells(3, i), Cells(lr, i))) = 0 Then Columns(i).Delete Shift:=xlToLeft End If Next i Application.ScreenUpdating = True End Sub وبهذا الكود انت لا تحتاج الى الصف رقم 284 اللى فيه مجموع الاعمده فانت فى غنى عنه تقبل تحياتى

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

بارك الله فيك ... اخي حامل المسك فكرة جميلة ...

السلام عليكم اقول : جزيت خيرا - جزيت خيرا - جزيت خير اقول : رزقك الله حظ الدنيا والاخرة اقول : تمام تمام تمام 100 % انتهى البطأ اشكرك

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