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

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله استناداً إلى الموضوع في الرابط التالي من هنا قمت بتطوير كود بحيث يمنع التكرار في العمود الأول ، وفي نفس الوقت يسمح للنسخ لخلية واحدة فقط ، أما إذا تم النسخ لأكثر من خلية فإنه يتم التراجع عن الأمر ومسح الخلايا المنسوخة ها هو الكود يوضع في حدث ورقة العمل ، ويتم التعامل مع العمود الأول 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 تقبلوا جميعاً وافر تقديري واحترامي حمل الملف من هنا تحميلك للملف يدعم صاحب الموضوع .. فلا تبخل بدقيقة من وقتك .. وللعلم يمكنك عدم تحميل الملف ونسخ الكود في موديول في المصنف الخاص بك ، وستجد الكود جاهز للعمل لديك بدون تحميل الملف .. دمتم على طاعة الله ...

السلام عليكم ورحمة الله وبركاتة اخوتى واحبتى فى الله كل عام وأنتم بخير وصحة وسلامة أدامهم الله عليكم وعلينا جميعا اليوم ان شاء الله تم الانتهاء من كارت الصنف الاصدارة المعدلة لأن النسخة السابقة كانت بطيئة وتمت تجربتها من قبل احد الاخوة وتم اعلامى وغير معقول ان تكون زكية وهى بطيئة ............؟؟؟؟؟؟؟؟؟ واليكم الرابط لمن يريد تحميلة http://www.officena.net/ib/index.php?showtopic=49408&hl= الحمد لله تم تجربة النسخة المعدلة واثبتت الكفاءة والسرعة ان شاء الله ولكنى انتظر اختباركم لها واعلامى عنها وعن التقارير التى بها فهى تحتوى على 2 تقرير التقرير الاول لأجمالى حركات الصنف خلال العام بشيت TotRep التقرير الثانى لتفاصيل حركة الصنف خلال شهر بشيت MonRep تم بحمد الله تكملة ترحيل باقى البنود رقم الاذن رقم الفاتورة + المرتجع ,كود المورد واسمة كود المندوب واسمة + صنف براحتك مفتوح الاضافات ولكن على قد اكسيل مطلوب تقييم التقارير ومدى اهميتها وهل توجد تقارير افضل من ذلك ام لا وهل هى تفى بالغرض ام لا ؟؟؟؟؟؟؟؟؟ واخذت فى الاعتبار حين الانشاء ثلاث اوجة نظر وهى على الترتيب 1- محاسب او امين المخزن الذى سيعمل على الملف ( سهل وسريع وبسيط ) 2- المحاسب الذى سيتولى مراجعتة ( سهل وبسيط ودقيق ) 3- المراجع والتقارير التى يحتاج أليها حتى يتأكد من سلامة النظام والتأكد من الارصدة خلال فترات محددة ( سهل وبسيط ودقيق ويحتوى على عدة تقارير لمطابقة ارصدة الصنف ) بالنسبة للعجز والزيادة الهلك والفاقد المهدر والكسر لم يتم التعرض لها بهذة الاصدارة ويمكن معالجتها محاسبيا بعمل حساب لها سواء مورد للزيادة او مندوب للصرف واخذها فى الاعتبارعند الجرد وهذا للضرورة القصوى تم انشاء نسخة اخرى تحتوى على تقارير اكثر ولكنها فى النهاية تصب فى نفس الهدف وادت الى ثقل ( بطئ ) الملف + كبر حجمة فقمت بألغائها ولكنها كانت اشمل واوفر اسهل بمعنى كان هناك تقرير بأسم YeaRep التقرير السنوى يتم تحديثة تلقائيا من الداتا المدخلة ايضا تقرير بأسم ThroPeriodRep تقرير خلال فترة زمنية محددة يتم عملة بتحديد تاريخ بداية وتاريخ نهاية ........!!!!!!!!!!!! انهما تقريران فعلا رائعان جدا جدا جدا ولكن للأسف لم تحضر معى افكارالمعادلات والوقت اللذان يكفيان لتنفيذ هذان التقريران هما او واحد منهم يغنى عن باقى التقارير وان كنت افضل التقرير ( ThroPeriodRep تقرير خلال فترة زمنية محددة ) مع التقريرالأجمالى حركات الصنف خلال العام بشيت TotRep لذا ارجو تجربة المرفق المرفق الاول بة التقريران الاوائل واخبرونى عن سرعتة واداءة اما المرفق الثانى ثقيل وبطىء وكبير الحجم ولم يكتمل ارجو ايضا تجربتة ومحاولة اكمال التقرير الثالث YeaRep التقرير السنوى والتقرير الرابع ThroPeriodRep تقرير خلال فترة زمنية محددة وحينها يمكننا ان نختار من يبقى ومن يذهب حتى تعود السرعة للملف وياحبذا ان كان التقرير الاول الاجمالى مع الرابع خلال فترة زمنية محددة وكل عام وانتم بخير وصحة وسلامة ان شاء الله دائمين عليكم معذرة شكرا لجميع اعضاء هذا الصرح العظيم واخص منهم من تعملت منهم كثيرا وكانت ملفاتهم ملهمى لفهم معالات كثيرة ودسمة استاتذتى ومعلمى الكبار الذين اتشرف ان أتتلمذ على يدهم بهذا الصرح العلامة المهندس / طارق محمود والرائع دائما العلامة استاذى / بن علية حاجى وملك المعالات / جمال عبد السميع بارك الله فيكم وتقبلوا فائق تحياتى كارته مخزن 3 المعدلة تقريران.rar كارته مخزن 3 اربعة تقارير.rar

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

بسم الله و ما شاء الله اهداء لمن قام بكل عمل و لا ينتظر مقابله اقل ما يقال لكم "عندما تنتهى كلمات الابداع عندكم و تبدأ من جديد و تنتهى عندكم" بارك الله لكم مدونة اعمال ايقونات الماس لمنتدى اوفيسنا _ شارك بتعديلاتك فكرة المدونة هى سهولة الوصول و البحث فى المنتدى مدونة (1) (موضوع مميز ) بعض الاكواد المنفصلة قد تهم البعض_بدأه الاستاذ / محمد يحياوى مدونة (2)امثلة عن كيفية استخدام أدوات الفورم (( متجدد ان شاء الله))_بدأه الاستاذ / ضاحى الغريب مدونة (3) طريقة عمل فورم فاتورة ووضع اكوادها وترحيلها واستدعائها وطباعتها !! خطوة خطوة_ بدأه الاستاذ / حماده عمر مدونة (4) طريقة عمل فورم بحث واظهار النتائج في ليست بوكس وتعديل النتائج !! خطوة خطوة_ بدأه الاستاذ / حماده عمر مدونة (5) طريقة عمل شاشة ( فورم ) ادخال وترحيل واستعلام وتعديل !! خطوة خطوة_ بدأه الاستاذ / حماده عمر مدونة (6) شرح كيفية استخدام الخلايا في الاكسل عند استخدام ال vba_ بدأه الاستاذ / عماد الحسامى مدونة (7) شرح كيفية استخدام الخلايا في الاكسل عند استخدام ال vba_ بدأه الاستاذ / عماد الحسامى مدونة (8) محفظة اكواد منوعة_ بدأه الاستاذ / عبدالله باقشير مدونة (9) شرح كيفية استخدام الخلايا في الاكسل عند استخدام ال vba_ بدأه الاستاذ / عماد الحسامى مدونة (10) ( موضوع مميز ) درس في الترحيل باستخدام الاكواد_ بدأه الاستاذ / عماد الحسامى مدونة (11) ( موضوع مميز )ملف كامل عن كيفية استحدام ال UserForm والتعامل مع كافة جوانبه_ بدأه الاستاذ / عماد الحسامى مدونة (12) (موضوع مميز ) اصنع صندوق الادوات وعناصر التحكم الخاصة بك في محرر الاكواد_ بدأه الاستاذ / محمد يحياوى مدونة (13) ايقونات و ازرار الماكرو ( تصاميم مختلفة )_ بدأه / الجزيرة مدونة (14) ملف من احد المنتديات الاجنبيه به معادلات شتى وصفيف رائعه_ بدأه الاستاذ/ ابو اياد ( الاسيوطى ) مدونة (15) (موضوع مميز) شرح بعض المعادلات وبعض الخصائص فى الاكسيل_ بدأه الاستاذ/ جمال الفاار

السلام عليكم عيدكم مبارك بالمرفق كود يعرض اسماء اوراق العمل بعد كتابة هذه المعادلة البسيطة في الورقة ()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 وإليكم الملف المرفق مطبق فيه الكود مع مثال بسيط حمل الملف من هنا تقبلوا تحياتي

السلام عليكم : حياكم الله ممكن تصميم زر طباعة الشيتات يكون حسب الاختيار ، مثلا : ( صندوق يظهر كل الشيتات فيتم الاختيار المطلوب ) زر طباعة الشيتات.rar

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

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

وعليكم السلام نعم يمكن لاحظ السطر الأصفر رقم 6 المعادلة موجودة فيه Book12.rar

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

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

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

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

شكرا استاذ محمد

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

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

أخي الكريم الخلل سببه عدم ضبط نتائج المعادلة لديك حيث يظهر الخطأ 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 تقبل تحياتي

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

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

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

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

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

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

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

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

السلام عليكم بالنسبة للسؤال الاول قم بما يلي امسح الخاصية RowSource لكل من الكمبوبكس الاول ة الثاني ثم انسخ هذا الكود بالنسبة للسؤال الثاني لم افهم المقصود Private Sub UserForm_Initialize() ComboBox1.Clear ComboBox2.Clear Dim R As Long With Sheets("æÑÞÉ1") For R = 2 To .Range("A" & .Rows.Count).End(xlUp).Row + 1 If CDate(.Cells(R, 3)) = Date Then If Application.WorksheetFunction.CountIf(.Range("A2:A" & R), .Cells(R, 1)) = 1 Then ComboBox1.AddItem CStr(.Range("A" & R)) ComboBox2.AddItem CStr(.Range("A" & R)) End If End If Next R End With End Sub

اخى الكريم جرب ايضا هذا الكود يفى بالغرض 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 اللى فيه مجموع الاعمده فانت فى غنى عنه تقبل تحياتى

وعليكم السلام ورحمة الله وبركاته أبي الحبيب أبو يوسف الحمد لله الذي هداك للتعلم وتعلي إخوانك .. بارك الله فيك وجزاك الله كل خير إضافة للموضوع وكودك هو الأفضل والأيسر والأسهل في التطبيق إليك حل بالأكواد لاستخراج البيانات بين تاريخين فقط بدون اية شروط أخرى ولكن باستخدام المصفوفات arrays كنوع من التدرب على استخدام المصفوفات Sub DataBetweenTwoDates() Dim Arr, Temp, I As Long, P As Long, startDate As Date, endDate As Date Arr = Range("B9").CurrentRegion.Offset(1).Value startDate = Range("C3").Value2: endDate = Range("C4").Value2 ReDim Temp(UBound(Arr, 1) - 1, UBound(Arr, 2) - 1) For I = LBound(Arr, 1) To UBound(Arr, 1) If Arr(I, 1) >= startDate And Arr(I, 1) <= endDate Then Temp(P, 0) = Arr(I, 1) Temp(P, 1) = Arr(I, 2) Temp(P, 2) = Arr(I, 3) Temp(P, 3) = Arr(I, 4) P = P + 1 End If Next I Range("L10").Resize(UBound(Temp, 1), UBound(Temp, 2) + 1).Value = Temp End Sub

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

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

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

السلام عليكم ورحمة الله وبركاته كل عام وانتم بخير دالة kh_ShowImage دالة تمكنك من وضع صورة داخل شكل تلقائي اتوماتيكيا يمكنك تغيير اسم او مسار مجلد الصور من داخل كود الدالة وسائط الدالة NameImag اسم الصورة افتراضي ImagRng خلية وضع الصورة افتراضي MyWidth عرض الصورة اختياري MyHeight طول الصورة اختياري ـ اذا لم تحدد طول او عرض معين للصورة تاخذ الصورة عرض وطول الخلية الموضوعة فيها ImagRng ـ اذا قمت بتحريك الصورة يدويا تفقد الصورة ارتباطها بالدالة وعند تحديث الدالة تقوم باضافة الصورة مرة اخرى في مكانها المحدد في الدالة كود الدالة: Option Explicit Option Compare Text '============================================= ' عرض صورة في الخليةِ ' Showing an image in cell '============================================= ' اسم مجلد الصور ' اذا كان مجلد الصور في نفس مجلد ملف الاكسل ' اكتب اسمه فقط ' والا اكتب المسار كاملا ' "D:\MyDocument\MyFunction\photo" Private Const kh_pic As String = "MyImeg" '============================================= ' امكانية تحرير اي نوع من الصور لديك ادناه Private Const MyTyp As String = ".jpg,.bmp,.gif,.png,.tif" '============================================= '============================================= Function kh_ShowImage(ByVal NameImag, ByVal ImagRng As Range, Optional ByVal MyWidth As Single, Optional ByVal MyHeight As Single) Dim Tp Dim shp As Shape Dim ibo As Boolean Dim MyTop As Single, MyLeft As Single Dim MyFile As String, MyPath As String '---------------------------------- On Error GoTo 1 '---------------------------------- MyTop = ImagRng.Top: MyLeft = ImagRng.Left With ImagRng.Worksheet For Each shp In .Shapes If shp.Top = MyTop And shp.Left = MyLeft Then shp.Delete: Exit For End If Next shp End With '----------------------------------- If IsEmpty(NameImag) Then GoTo 1 '----------------------------------- If MyWidth = 0 Then MyWidth = ImagRng.Width If MyHeight = 0 Then MyHeight = ImagRng.Height '----------------------------------- If Not InStr(kh_pic, ":") Then MyPath = ThisWorkbook.path & "\" MyFile = MyPath & kh_pic & "\" & CStr(NameImag) '----------------------------------- For Each Tp In Split(MyTyp, ",") If Not Dir(MyFile & Trim(Tp), vbDirectory) = vbNullString Then With ImagRng.Worksheet.Shapes.AddShape(msoShapeRectangle, MyLeft, MyTop, MyWidth, MyHeight) .Fill.UserPicture MyFile & Trim(Tp) End With ibo = True Exit For End If Next 1 kh_ShowImage = ibo End Function المرفق 2003-2010 دالة عرض صورة في خلية بطول وعرض اختياري.rar

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

تفضل تم التعديل حسب رغبتك لطباعة التقرير اضغط ctrl+P بطاقات2.rar

أخي الكريم أذا كنت تستعمل نظام التشغيل ويندوز 7 وعموما يوجد مشكلة في تسجيل المراجع في ويندوز 7 حيث تحتاج عملية التسجيل إلى صلاحيات المدير المسئول ولذلك لتسجيل الأداه قم بالضغط على start ثم اكتب cmd في مربع البحث عن البرامج وحينما يظهر سطر الأوامر اضغط بزر الفارة الأيمن عليه واختر Run as Administrator وبعدها شغل الأمر التالي فيه ثم اضغط انتر regsvr32 Msinet.ocx وبإن الله سوف تأتيك رسالة النجاح في التسجيل ..... جرب وأخبرني بالنتيجة