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

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

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته أيها الأحبة منذ أن بدأت في تعلم الأكسس حيث كانت بداياتي في هذا المنتدى المبارك وكنت أتمنى طريقة شرح معينة حيث إن المبتدئ منا لا يحتاج للشيء النظري البحث إنما يحتاج لإنارة الطريق حتى يصل إلى المطلوب من خلال أمثلة مبسطة وذلك بحكم أن ليس كل مشارك في المنتدى متخصص في البرمجة ونحوها .. وكنت منذ أن بدأت أجمع الأمثلة ثم أقوم بفكها والنظر في الاكواد ونحوها وكان يشكل علي كثيرا معرفة اسم النموذج في الكود والسجل ونحوها وتمييزها عن بقية الكود فالكود أحيانا يكون به كلمات إنجليزية هي أساس في الكود فلا تتغير إنما الذي يتغير كلمات معينة كاسم النموذج أو السجل أو الاستعلام ونحوها ... وكم عانيت في ذلك وخاصة إذا كان المثال معقدا. ومن هذا أحببت أن نبدأ جميعًا في مشروع أظنه نافعا بإذن الله تعالى وما كان لي أن أطرحه دون إذن أساتذتي الفضلاء الذي لهم سبق فضل علي بعد فضل الله بارك الله في علمهم وعملهم ... وتكمن الفكرة في هذا الموضوع أن يتم تخصيص هذا الموضوع بموضع معين مثلا طرائق البحث في نموذج أكسس فكل منا يجتهد في طرح ما يعرفه من طرائق البحث في نماذج أكسس بشرط أن تشرح بشرح وافي بالمثال بحيث تكون مرجعا لمن أراد البحث في هذا الموضوع (طرق البحث في الأكسس) وعلى ذلك أستأذنكم في طرح مثال أُسرُّ من خلال برأيكم وملحوظاتكم حيث إني لم أقف في شبكة الإنترنت على من تولى مثل ذلك وأتمنى أن يكون لهذا المنتدى قصب السبق ... عنوان الموضوع طرائق البحث في الأكسس : الطريقة الأولى : البحث في النموذج بكتابة جز من الكلمة نفرض أن لدينا جدولا اسمه Book يهتم بأسماء الكتب ونرغب أن نبحث عن كتاب معين بمجرد كتابة جزء من اسمه فنعمل الآتي: 1)نصمم جدولا باسم Book بداخله أسماء كتب تحت سجل nameBook 2) نصمم نموذجا مبني على جدول Book بنماذج مستمرة وليكن اسم النموذج FormBook. 3) ندرج في أعلى النموذج (رأس النموذج ) مربع نص ونسميه فرضا Text1 وبالطبع التسمية من خلال الضغط على مربع التسمية بالزر الأيمن ثم خصائص ثم غير ذلك ثم في خانة الاسم نكتب الاسم المطلوب. 4) نقوم بعمل استعلام مبني على جدول Book وليكن اسمه Qry في الاستعلام نجد سجل NameBook نكتب في الحقل الفارغ الذي بجواره الكود التالي : nz([book].[namebook];"**") حيث إن Book اسم الجدول و NameBook اسم السجل الذي بداخل الجدول. 5) في الاستعلام في المعايير تحت حقل الذي تم عمله في الفقرة رقم (4) نضع الكود التالي Like "*" & [forms]![formbook]![text1] & "*" حيث FormBook هو اسم النموذج و Text1 اسم مربع النص الذي تم إدراجه في رأس النموذج. 6) نذهب إلى النموذج ونضع المؤشر على مربع النص text1 ثم الزر الأيمن ثم خصائص ثم حدث ثم بعد التحديث نضع الأمر التالي Me.Requery 7) نذهب إلى خصائص النموذج من خلال الضغط على أي مكان فارغ في النموذج ثم الزر الأيمن ثم خصائص ثم نختار بيانات ثم مصدر السجل ثم نختار منه اسم الاستعلام Qry بعد ذلك يكون النموذج جاهزا للبحث فيه عن أي كتاب ويمكن تكرار ذلك لأكثر من مربع نص بنفس الخطوات السابقة وبالمثال يتضح المقال. ((هذا نموذج إن كان مناسبا نستمر عليه ليكون مرجعا ثم ننتقل إلى موضوع آخر (ولا ولا ولا أستغني عن الرأي والمشووورة وهذا جهد المقل) ...) والله الموفق طرائق البحث.rar

السلام عليكم ورحمة الله وبركاتة اخوتى واحبتى فى الله كل عام وأنتم بخير وصحة وسلامة أدامهم الله عليكم وعلينا جميعا اليوم ان شاء الله تم الانتهاء من كارت الصنف الاصدارة المعدلة لأن النسخة السابقة كانت بطيئة وتمت تجربتها من قبل احد الاخوة وتم اعلامى وغير معقول ان تكون زكية وهى بطيئة ............؟؟؟؟؟؟؟؟؟ واليكم الرابط لمن يريد تحميلة 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) طريقة عمل فورم بحث واظهار النتائج في ليست بوكس وتعديل النتائج !! خطوة خطوة_ بدأه الاستاذ / حماده عمر مدونة (5) طريقة عمل شاشة ( فورم ) ادخال وترحيل واستعلام وتعديل !! خطوة خطوة_ بدأه الاستاذ / حماده عمر مدونة (6) شرح كيفية استخدام الخلايا في الاكسل عند استخدام ال vba_ بدأه الاستاذ / عماد الحسامى مدونة (7) شرح كيفية استخدام الخلايا في الاكسل عند استخدام ال vba_ بدأه الاستاذ / عماد الحسامى مدونة (8) محفظة اكواد منوعة_ بدأه الاستاذ / عبدالله باقشير مدونة (9) شرح كيفية استخدام الخلايا في الاكسل عند استخدام ال vba_ بدأه الاستاذ / عماد الحسامى مدونة (10) ( موضوع مميز ) درس في الترحيل باستخدام الاكواد_ بدأه الاستاذ / عماد الحسامى مدونة (11) ( موضوع مميز )ملف كامل عن كيفية استحدام ال UserForm والتعامل مع كافة جوانبه_ بدأه الاستاذ / عماد الحسامى مدونة (12) (موضوع مميز ) اصنع صندوق الادوات وعناصر التحكم الخاصة بك في محرر الاكواد_ بدأه الاستاذ / محمد يحياوى مدونة (13) ايقونات و ازرار الماكرو ( تصاميم مختلفة )_ بدأه / الجزيرة مدونة (14) ملف من احد المنتديات الاجنبيه به معادلات شتى وصفيف رائعه_ بدأه الاستاذ/ ابو اياد ( الاسيوطى ) مدونة (15) (موضوع مميز) شرح بعض المعادلات وبعض الخصائص فى الاكسيل_ بدأه الاستاذ/ جمال الفاار

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

وراك وراك لحد ما تلاقي البطاقة وتقولنا على اسمك المكتوب فيها .. متحاولش تهرب !! هتهرب تروح على فين يا نور العين !!

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

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

http://www.officena.net/ib/topic/61446-برنامج-محاسبة-accurate-من-تصميمي/#comment-396473 السلام عليكم في الفاتورة وتعديلها لا انصحك باستخدام استعلام تحديث لانه قد يكون التعديل هو حذف سطر من الفاتورة او اضافة سطر واستعلام تحديث لا يمكنه اضافة سطر او حذفه وهذا يعني يجب عليك استخدام استعلام حذف ثم استعلام الحاق مرة اخرى اما بشان الاستعلامات فراجع الرابط التالي وحمل البرنامج ففيه استعلامات الحاق وحذف وتحديث بما يكفي وستجد امثلة جيدة لما تريد

اخوي ابومصطفى ، للأسف اسماء النماذج / الاستعلامات اللي تقوم بالعمل ، ما كانت موجودة في اول مشاركة لك ، ولا في آخر مشاركة الله يطول في عمرك ان شاء الله ، ساعدنا علشان نساعدك جعفر

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

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

وجزيت خيراً أخي وحبيبي حسام عيسى صقر المنتدى نورت الموضوع بردك الجميل

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

بارك الله فيك أخي الكريم عبد الله فاروق على إحياء الموضوعات القديمة ليستفيد منه الأعضاء الجدد والقدامي إليك دالة معرفة شبيهة لما قدمت في المشاركة الأولى Function SheetName(rCell As Range, Optional UseAsRef As Boolean) As String Application.Volatile If UseAsRef = True Then SheetName = "'" & rCell.Parent.Name & "'!" Else SheetName = rCell.Parent.Name End If End Function لاستخدام الدالة .. قم في أي خلية بوضع المعادلة التالية =SheetName(A1) تقبل تحياتي

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

الحمدلله يا اخوان توصلت للحل VBA لا يستطيع تمييز التواريخ في صيغه تيكست حتى يعمل بحث بالتاريخ او اي عمليات اخرى لذى يجب تحويل التكست الى صيغه تاريخ معروفه وهي dd/mm/yyyy وذلك باستخدام الخاصيه text to columnتقوم بتقسيم التاريخ المكتوب بشكل تكست على اعمدة عمود يوم وعمود شهر وعمود سنه ثم تجميعها مره اخرى في عمود اخر بصيغه dd/mm/yyyy لتمكن من تطبيق العمليات على التاريخ بهذه الداله qعمود السنه p عمود الشهر oعمود اليوم =Date(Q2,Month(1&O2),P2))

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

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

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

أخي الحبيب أبو يوسف جزاكم الله خيراً على هذه الموضوعات الجديدة والمتميزة والرائعة بحق بارك الله فيك وجزاك الله كل خير .. انتظرت في الرد حتى أقوم بتجربة الأكواد المقدمة .. الكود الثاني يعمل بشكل جيد تماماً الكود الأول سليم ولا عيب به سوى شيء بسيط جداً جداً .. وهو أنه لا يقوم بإدراج صف جديد إلا بعد الضغط على TAB من لوحة المفاتيح .. وبهذا ليس له فائدة حيث أن الضغط على TAB يفعل الكود الثاني وليس الأول ..أي الإدراج في هذه الحالة يكون مرتبط بالكود الثاني المطلوب عمله لتصحيح الكود الأول وجعله يقوم بعملية الإدراج هو أن تضيف للمتغير N الرقم 1 .. بحيث يصبح السطر بهذا الشكل .ListObjects(1).Resize Range("$C$4:$E$" & n + 1) وأخيراً تقبل وافر تقديري واحترامي

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

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

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

السلام عليكم بالنسبة للسؤال الاول قم بما يلي امسح الخاصية 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

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

و عليكم السلام و رحمة الله و بركاته ... DLast("[asm]";"alasmaa") آخر اسم من جدول الاسماء ...

اخى الحبيب ابوالبراء الداله موجوده فى اوفيس 2016 وليست معرفه اعمل تحديث يا ابوالبراء من خيارات الاكسيل تقبل تحياتى

السلام عليكم اخي الكريم هذا كود التفقيط ضعه في وحدة نمطية واستدعيه ضمن مربع النص Function NoToTxt(TheNo As Double, MyCur As String, MySubCur As String) As String Dim MyArry1(0 To 9) As String Dim MyArry2(0 To 9) As String Dim MyArry3(0 To 9) As String Dim MyNo As String Dim GetNo As String Dim RdNo As String Dim My100 As String Dim My10 As String Dim My1 As String Dim My11 As String Dim My12 As String Dim GetTxt As String Dim Mybillion As String Dim MyMillion As String Dim MyThou As String Dim MyHun As String Dim MyFraction As String Dim MyAnd As String Dim i As Integer Dim ReMark As String If TheNo > 999999999999.99 Then Exit Function If TheNo = 0 Then NoToTxt = "صفر" Exit Function End If MyAnd = " و" MyArry1(0) = "" MyArry1(1) = "مائة" MyArry1(2) = "مائتان" MyArry1(3) = "ثلاثمائة" MyArry1(4) = "أربعمائة" MyArry1(5) = "خمسمائة" MyArry1(6) = "ستمائة" MyArry1(7) = "سبعمائة" MyArry1(8) = "ثمانمائة" MyArry1(9) = "تسعمائة" MyArry2(0) = "" MyArry2(1) = " عشر" MyArry2(2) = "عشرون" MyArry2(3) = "ثلاثون" MyArry2(4) = "أربعون" MyArry2(5) = "خمسون" MyArry2(6) = "ستون" MyArry2(7) = "سبعون" MyArry2(8) = "ثمانون" MyArry2(9) = "تسعون" MyArry3(0) = "" MyArry3(1) = "واحد" MyArry3(2) = "اثنان" MyArry3(3) = "ثلاثة" MyArry3(4) = "أربعة" MyArry3(5) = "خمسة" MyArry3(6) = "ستة" MyArry3(7) = "سبعة" MyArry3(8) = "ثمانية" MyArry3(9) = "تسعة" '====================== GetNo = Format(TheNo, "000000000000.00") i = 0 Do While i < 15 If i < 12 Then MyNo = Mid$(GetNo, i + 1, 3) Else MyNo = "0" + Mid$(GetNo, i + 2, 2) End If If (Mid$(MyNo, 1, 3)) > 0 Then RdNo = Mid$(MyNo, 1, 1) My100 = MyArry1(RdNo) RdNo = Mid$(MyNo, 3, 1) My1 = MyArry3(RdNo) RdNo = Mid$(MyNo, 2, 1) My10 = MyArry2(RdNo) If Mid$(MyNo, 2, 2) = 11 Then My11 = "إحدى عشر" If Mid$(MyNo, 2, 2) = 12 Then My12 = "إثنى عشر" If Mid$(MyNo, 2, 2) = 10 Then My10 = "عشرة" If ((Mid$(MyNo, 1, 1)) > 0) And ((Mid$(MyNo, 2, 2)) > 0) Then My100 = My100 + MyAnd If ((Mid$(MyNo, 3, 1)) > 0) And ((Mid$(MyNo, 2, 1)) > 1) Then My1 = My1 + MyAnd GetTxt = My100 + My1 + My10 If ((Mid$(MyNo, 3, 1)) = 1) And ((Mid$(MyNo, 2, 1)) = 1) Then GetTxt = My100 + My11 If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My11 End If If ((Mid$(MyNo, 3, 1)) = 2) And ((Mid$(MyNo, 2, 1)) = 1) Then GetTxt = My100 + My12 If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My12 End If If (i = 0) And (GetTxt <> "") Then If ((Mid$(MyNo, 1, 3)) > 10) Then Mybillion = GetTxt + " مليار" Else Mybillion = GetTxt + " مليارات" If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " مليار" If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " ملياران" End If End If If (i = 3) And (GetTxt <> "") Then If ((Mid$(MyNo, 1, 3)) > 10) Then MyMillion = GetTxt + " مليون" Else MyMillion = GetTxt + " ملايين" If ((Mid$(MyNo, 1, 3)) = 1) Then MyMillion = " مليون" If ((Mid$(MyNo, 1, 3)) = 2) Then MyMillion = " مليونان" End If End If If (i = 6) And (GetTxt <> "") Then If ((Mid$(MyNo, 1, 3)) > 10) Then MyThou = GetTxt + " ألف" Else MyThou = GetTxt + " آلاف" If ((Mid$(MyNo, 3, 1)) = 1) Then MyThou = " ألف" If ((Mid$(MyNo, 3, 1)) = 2) Then MyThou = " ألفان" End If End If If (i = 9) And (GetTxt <> "") Then MyHun = GetTxt If (i = 12) And (GetTxt <> "") Then MyFraction = GetTxt End If i = i + 3 Loop If (Mybillion <> "") Then If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd End If If (MyMillion <> "") Then If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd End If If (MyThou <> "") Then If (MyHun <> "") Then MyThou = MyThou + MyAnd End If If MyFraction <> "" Then If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur Else NoToTxt = ReMark + MyFraction + " " + MySubCur End If Else NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur End If End Function

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

أخي الفاضل أبو لجين إليك الدالة التالية وإن شاء الله تفي بالغرض بالنسبة لأي طلب جديد لا يخص هذا الطلب يرجى طرح موضوع مستقل Function CalString(sInp As String) As Long Static bInit As Boolean Dim asMap() As String Dim asLtr() As String Dim I As Long Static aiVal(0 To 255) As Long If Not bInit Then asMap = Split("1 1 1 1 1 1 2 3 4 5 6 7 8 9 10 20 30 40 50 60 70 80 90 100 200 300 400 500 600 700 800 900 1000") asLtr = Split("ء أ إ آ ا ئ ب ج د ه و ز ح ط ي ك ل م ن س ع ف ص ق ر ش ت ـة ث خ ذ ض ظ غ") For I = 0 To UBound(asMap) aiVal(Asc(asLtr(I))) = asMap(I) Next I bInit = True End If For I = 1 To Len(sInp) CalString = CalString + aiVal(Asc(Mid(sInp, I, 1))) Next I End Function وإليك أيضاً ملف مرفق فيه تطبيق لاستخدام الدالة تقبل تحياتي ABJAD Calculator UDF Function YasserKhalil.rar

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

السلام عليكم ورحمة الله وبركاته كل عام وانتم بخير دالة 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 وبإن الله سوف تأتيك رسالة النجاح في التسجيل ..... جرب وأخبرني بالنتيجة

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