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

احوانى واخواتى ابنائى وبناتى وكل مجتمع اوفسينا التقيكم مجدداً فى هذا الدرس الجديد اخترت له اسم الثلاثيه العجيبه upper lower proper(3).rar

السلام عليكم دالة استخراج تاريخ الميلاد او النوع او المحافظة من الرقم القومي ثلاثة معطيات بدالة واحدة Option Explicit ' بسم الله الرحمن الرحيم ' ******************** ' دالـــــــــــــــة ' Kh_Date_Sex_Province ' ( استخراج تاريخ الميلاد او النوع (ذكر - انثى ' او المحافظة من الرقم القومي '============================================== ' MyTest ' اذا كانت = 1 تقوم باستخراج تاريخ الميلاد ' اذا كانت = 2 تقوم باستخراج النوع ' اذا كانت = 3 تقوم باستخراج المحافظة '---------------------------------------------- ' MyProvinces في متغير الجدول ' العمل لم يستكمل بعد ' يمكنك إضافة المحافظات الاخرى الغير موجودة ' او تعديل الموجود في حالات الخطأ ' بنفس الطريقة الرقم اولا ثم "/" ثم اسم المحافظة ' : مثال على ذلك ' "01/القاهرة" '============================================== '----------------------------------------------------------------- Function Kh_Date_Sex_Province(MyNumber As Variant, MyTest As Byte) Dim MyProvinces As Variant Dim r As Integer Dim yy As String Dim ty As String * 1 Dim d As String * 2, m As String * 2, y As String * 2 _ , x As String * 2, xx As String * 2 '============================================== ' يمكنك إضافة المحافظات الاخرى الغير موجودة ' او تعديل الموجود في حالات الخطأ MyProvinces = Array("01/القاهرة", "02/الإسكندرية", "12/الدقهلية", "13/الشرقية" _ , "14/القليوبية", "15/كفر الشيخ", "16/الغربية", "17/المنوفية", "18/البحيرة" _ , "19/الإسماعيلية", "21/الجيزة", "22/بني سويف", "24/المنيا", "25/أسيوط" _ , "26/سوهاج", "27/قنا", "28/أسوان", "29/الأقصر", "33/مطروح") '============================================== Kh_Date_Sex_Province = "" On Error GoTo 1 If Len(Trim(MyNumber)) = 0 Then GoTo 1 End If If Not IsNumeric(MyNumber) Or Len(MyNumber) <> 14 Then Kh_Date_Sex_Province = "Error_MyNumber" GoTo 1 End If If MyTest = 1 Then d = Mid(MyNumber, 6, 2) m = Mid(MyNumber, 4, 2) y = Mid(MyNumber, 2, 2) ty = Left(MyNumber, 1) Select Case ty Case "2": yy = y Case "3": yy = "20" & y Case Else: yy = "" End Select If yy <> "" Then Kh_Date_Sex_Province = DateSerial(yy, m, d) ElseIf MyTest = 2 Then If Left(Right(MyNumber, 2), 1) Mod 2 = 1 Then _ yy = "ذكر" Else yy = "انثى" Kh_Date_Sex_Province = yy ElseIf MyTest = 3 Then x = Mid(MyNumber, 8, 2) For r = LBound(MyProvinces) To UBound(MyProvinces) xx = MyProvinces(r) If x = xx Then Kh_Date_Sex_Province = Right(MyProvinces(r), Len(MyProvinces(r)) - 3) Exit For End If Next End If 1: End Function بالنسبة لمعطيات المحافظات لم تستكمل بعد ويمكنك اضافة المحافظات المتبقية حسب ما شرحت بالكود خبور خير دالة استخلاص تاريخ الميلاد و النوع و المحافظة من الرقم القومي.rar

أخى مهند هذا هو شرح كود الاخفاء Sub ragab() 'تعريف المتغيرات Dim rng As Range Dim cl As Range Dim LC As Integer 'ايقاف اهتزاز الشاشة لتسريع الكود Application.ScreenUpdating = False 'تحديد رقم آخر عمود فارغ فى الصف الأول LC = Range("A1").End(xlToRight).Column 'تحديد المدى بالخلايا المحتوية على المجموع فى الصف الحادى عشر Set rng = Range(Cells(11, 2), Cells(11, LC)) 'حلقة تكرارية لمعرفة الخلايا المحتوية على القيمة صفر فى المجموع For Each cl In rng If cl.Value = 0 Then 'اخفاء عمود الخلايا المحتوية على صفر cl.EntireColumn.Hidden = True End If Next ' ارجاع اهتزاز الشاشة Application.ScreenUpdating = True End Sub وبالنسبة لكود الاظهار فهو يقوم بالعملية العكسية

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

وعليكم السلام الطريقة الصحيحة لوضع قاعدة البيانات على الشبكة ، هي ان تعملها جزئين ، جزء للجداول (وتسمى BE) ، وجزء لباقي كائنات البرنامج (وتسمى FE)، جزء الجداول يكون على مجلد على الشبكة ، ويكون لجميع المستخدمين صلاحيات القراءة/التغيير ، جزء بقية الكائنات ، يكون على كمبيوتر كل مستخدم ، وتكون جداول الجزء الاول مرتبطة مع هذا الجزء. هناك عدة طرق لعمل تحديث لجزء الكائنات ، بحيث يقوم المبرمج بوضع النسخة الجديدة في نفس مجلد جزء الجداول على الشبكة (لأن جميع المستخدمين عندهم صلاحيات القراءة/التغيير للمجلد هذا ، مما يجعل هذا المجلد هو المجلد الاسهل للإستعمال)، احد طرق التحديث: 1. ان تعمل جدول في جزء الجداول ، ويكون فيه حقل واحد ، وقيمة واحدة فقط ، وهي رقم التحديث ، وطبعا هذا الجدول سيكون مربوط مثل بقية الجداول ، بالجزء الثاني ، 2. وفي جزء بقية الكائنات ، تعمل جدول محلّي ، اي غير مرتبط مع الجزء الاول ، ويكون فيه حقل واحد ، وقيمة واحدة فقط ، وهي رقم النسخة الحالية للجزء الثاني ، 3. عند تشغيل الجزء الثاني ، فسيعمل مقارنة بين رقم نسخته (من الجدول المحلي) ، ورقم نسخة التحديث (من الجدول المرتبط) ، فاذا تطابقت الارقام ، فمعناه انه لا يوجد نسخة جديدة ، اما اذا لم تتطابق الارقام ، فمعناه ان هناك نسخة جديدة موجودة ، ويجب ان يتم استبدال نسخته (التي على كمبيوتره ، بتلك التي في الشبكة) هذه صلب الفكرة جعفر

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

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

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

أخي الكريم يرجى تغيير اسم الظهور ليعبر عن شخصكم الكريم إليك الكود التالي عله يفي بالغرض Sub CountCells() Dim Ws As Worksheet, Cel As Range, I As Integer Set Ws = ActiveSheet Application.ScreenUpdating = False For Each Ws In ThisWorkbook.Worksheets For Each Cel In Ws.Range("I7:I" & Ws.Cells(Rows.Count, "I").End(xlUp).Row) If GetCellColorForReals(Cel) = 65535 Then I = I + 1 Next Cel Next Ws If I = 0 Then MsgBox "لا يوجد خلايا ملونة", 64 Else MsgBox "عدد الخلايا الملونة يساوي " & I End If Application.ScreenUpdating = False End Sub Function GetCellColorForReals(R As Range) As Long GetCellColorForReals = R.DisplayFormat.Interior.Color End Function تقبل تحياتي

أخواني الأعزاء في هذا المنتدى : أضع بين أيديكم العديد من البرامج الجاهزة مع الشرح الكامل ، جمعتها من موقع أجنبي و فيها العديد من المستويات المبتدئ المتوسط المتقدم حيث قمت بتجميعها من العديد من المواقع و المنتديات الأجنبية ليتم حصرها في منتدانا الحبيب هذا أرجو منكم الرد لوضع المزيد من البرامج ، حيث ومن خلال ردودكم سأقوم بوضع إحتياجاتكم من البرامج في حال توفرها لدي ، حيث يوجد لدي مكتبة كبيرة من البرامج تحتوي ما يقارب 3000 برنامج و هناك المزيد . مع الشكر للجميع و أريد منكم فقط دعوة من قلب صادق لي و لوالدي ،،، accarch181.zip accarch180.zip

بسم الله الرحمن الرحيم وجدت كثيرا من الاعضاء تطلب هذا الموضوع كثيرا وعندما وضعت مثال لشاشة دخول بكلمة مرورظهر ليا مشرف كدا كالعادة وقالي البوقين دول كنت أفضل يكون في موضوع مستقل لأن المشاركات الفرعية تندثر مع الوقت لما تلاقي نفسك عملت ملف مميز زي كدا .. افتح موضوع جديد واشرح بالتفصيل (مش ترمي الملف وتجري ..) وبعد كدا في المشاركة الفرعية تضع رابط للموضوع ليستفيد أكبر عدد من الأعضاء إذ أن المتابعين للمشاركات قلة .. ولكن هناك كثر في انتظار الموضوعات الجديدة للتعلم والاستفادة .. متنساش كلامي يا سكر زيادة وانا حبيت اوجه له رسالة من هنا واقول له انا بحب الشاي سكر خفيف المهم حبيبي الغالي فعلا صدق في كلامه فا نخش في الموضوع وبلاش رغي بقي اولا نفتح بقي ملف اكسيل جديد ونخش محرر الاكواد ونعمل يوزر فورم جديد ونقوم بوضع عدد واحد ليبل عشان نتكب فيها كلمة المرور او رمز الحماية او أي حاجه في أي حاجه اثنين تكست بوكس الاول لكتابة المستخدم داخلها كلمة المرور اللي هيكتبها عند الدخول الثاني مش مهم لينا كل لزمته انه كل ما المستخدم يحط رقم غلط يزود فيه رقم لحد لما يوصل للرقم المحدد لاغلاق البرنامج وتظهر رسالة تقوله GAME OVER بمعني انه استنفذ كل المحاولات وجاري اغلاق البرنامج وواحد كومند زرار يعني عشان ندوس عليه للدخول ز ما احنا شايفين وطبعا متنسوش تحطه خلفيه حلوة كدا للفورم دا اهم حاجه عندي اه كله الا الجماليات وموضوع الجماليات دا نعمله موضوع قريب ان شاء الله بس تكون عندكو لسعه فوتوشوب بس وطبعا نخلي الخلفية علي وضع الاسترتش اه يعني الصورة تبقي لازقه في الفورم كيبر تكبر معاه يصغر تصغر معاه تمام كلنا عارفين الاسترتش كويس زي ما احنا شايفين نيجي بقي للاكواد اول كود نحطه في الجينرال بقي اول حاجه 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 Const GWL_STYLE = -16 Const WS_CAPTION = &HC00000 Const WS_SYSMENU = &H80000 والكود التاني في حدث تهيئة اليوزر فورم Private Sub UserForm_Initialize() Dim lngWindow As Long, lFrmHdl As Long lFrmHdl = FindWindow(vbNullString, Me.Caption) lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE) lngWindow = lngWindow And (Not WS_CAPTION) Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow) Call DrawMenuBar(lFrmHdl) End Sub toolwindowودول لزوم الفشخرة والمنظره وعشان نقصقص البتاعه دي ويضفي جمالا للفورمة هي الخيارات بتاعتها متاحه في الفيجوال بيسك عادي زي كدا ننفض للحته دي نخش علي الكود اثالث ودا هيبقي في تنشيط اليوزر فورم Private Sub UserForm_Activate() Application.WindowState = xlMaximized With Me .Height = Application.Height .Width = Application.Width .Left = Application.Left .Top = Application.Top End With End Sub ايه الكلام دا دا ياسيدي بنقوله كبر لنا البرنامج ملئ الشاشة Maximized لما تفتح اليوزر فورم زي الشاطر خلي مقاسات اليوزر فورم زي مقاسات البرنامج واحنا مكبرين شاشة البرنامج يبقي كدا اليوزر فورم هيبقى كبير زي البرنامج تمام كدا الكود الرابع Private Sub CommandButton1_Click() If TextBox1.Text = "123" Then Me.Hide Else am = am + 1 MsgBox " لقد استخدمت " & am & " محاولة من اصل 5 محاولات, vbCritical, "elmalak_elhazen_yasser@yahoo.com" If am = 5 Then MsgBox "لقد استنفذت جميع المحاولات" ActiveWorkbook.Save ActiveWorkbook.Close End If End If End Sub اكيد دماغكو لفت معايا معلش انا شرحي علي قده استحملوني دا كود بيقول اذا كانت التكست بوكس واحد بتساوي 123 اذن ياعم اخفيني من وشك ويظهر معاك ملف الاكسيل عادي طيب اذا ما حصلشي بقي نعمل ايه تعالا بقي am دي اسم التكست بوكس اتنين بس انا غيرته الى am ندوس علي التكست بوكس اتنين ونغيره من هنا ومننساش نخفى التكست بوكس دا من هنا واحد فكيك بقي يقول ليه am اقوله ياناصح دول اول حرف من اسيل واول حرف من محمد ولادي تمام يامعلم محدش يشتم ولا يضرب المهم بقي ان am بتساوي نفسها + 1 تمام اه قبل ما انسى نخلي قيمة am دي بصفر نكتب جواها صفر عشان لما يعد يعد من بعد الصفر يعني كل ما المعلم يدوس غلط يزود رقم واحد وتطلع رسالة تقوله وصلت لكام محاولة ولما يوصل للمحاولة الخامسة يقوله بالسلامة ياحبي انا هقفل وانام وتمام كدا زي الفل والكلام خدنا والدرس خلص شفتوا انتو مش مصحصحين ازاي نسينا نحط كود فتح الفورم في حدث فتح الملف Private Sub Workbook_Open() UserForm1.Show End Sub وبعدين انا مش هحط امثلة زي واحد صاحبي وحبيبي بيقول انكم لازم تتعبوا شوية وتعملوها بنفسكوا بدل ما تخدو كوبي وبست وخلاص للحديث بقية باذن الله لاستكمال اضافات تانيه اتمنى من الله ان ينفعكم هذا الشرح تقبلو تحياتي ياسر العربي قلت اضيف صورة الكود لكمعشان ميبقاش ليكو حجه

هل تقصد هكذا ترحيل بيانات.rar

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

تفضل أخى تم فصل الكود الى كودين كما تريد ترحيل بيانات.rar

اخي الفاضل محرر الاكواد محمى بكلمة سر فارجو الغاء الحماية حتى يتسنى للجميع المساعدة

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

جربت الكود شغال ومرفق النتيجه جزاك الله كل خير اخى ياسر ملف تجربة1.rar

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

تجربة ناجحة تمام ا / ياسر

أخى ياسر أخى شبكة النبراس الإسلامية الكود يعمل عندى بشكل ممتاز تسلم ايديك أخى ياسر أنا اعمل على أوفيس 2010

بارك الله فيك يا مبدع

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

ماشاء الله عمل جميل الله يبارك لك في عملك ويوفقنا واياك لما يحب ويرضى بالتوفيق

ربما ينال اعجابك التأخيرات salim.rar

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

تفضل أخى علما بان اسم المستخدم ragab وكلمة المرور 123 ويمكنك تغيرهما من الخلايا AZ1 و AZ2 من الصفحة الأولى prchi Raspi Food Cost 1.rar

بالفعل نفس العدد ونفس النتيجة جزاكما الله خيرا على هذه المساعده وهذا المجهود

وعليكم السلام ورحمة الله أهلا بك أخي.. تفضل الجمع بهذه الدالة وانظر النموذج بمرفقك بعد وضع بيانات تجريبية =DCount("Job";"Data";" Job = 'General Manager'") test2.rar

أخي الكريم مهند لما لا تطرح موضوع جديد لتجد استجابة أكثر مع التوضيح التام لطلبك مع إرفاق لشكل النتائج المتوقعة إذا تطلب الأمر أخي الحبيب رجب جاويش حاول أن تبتعد قدر الإمكان عن الحلقات التكرارية لما لها من أثر في بطء عمل الكود خصوصاً إذا كانت البيانات كبيرة ما رأيك بفكر جديد وهو استخدام خاصية الفلترة ..جرب الكود التالي Sub HideRowsUsingFilterMethod() Dim Rng As Range Application.ScreenUpdating = False On Error Resume Next With ActiveSheet .AutoFilterMode = False .Range("C12:C65512").AutoFilter Field:=1, Criteria1:="=0", Operator:=xlOr, Criteria2:="" Set Rng = .Range("C13:C65512").SpecialCells(xlCellTypeVisible) .AutoFilterMode = False Rng.EntireRow.Hidden = True End With Application.ScreenUpdating = True End Sub تقبل تحياتي

اخي عبد العزيز كل الشكر والتقدير لشخصكم الكريم السر قالو ليك حبيبي ابو البراء انا لو فايق كنت فتيت لك في موضوع السر دا اصلي بحب الرغي فهمهالي بس ع جمب كدا مرفق نسخة متوافقه مع 2003 Hack VBA.rar اخي الغالي ا/محمد الدسوقي شكرا على كلماتك الجميلة وهذه اراها مبالغة وانت تقدر تعدينا كمان بس يكون في عزيمة ولما يكون عندك عزيمةابقى اعزمني معلش بحب الرخامة شوية تقبل فائق احترامي اما بخصوص العتاب اخي الغالي الاكواد موجودة ومتداولة بين المعظم ولكن الاغلب بيكسل او صعب عليه التطبيق وبيرجع لينا وبيطلب فك حماية الملف وننتظر منه تاكيد ان لا يعتبر تعدي علي برامج الغير وبعدين نفك الملف ونرسله الملف فسهلت العمليه وكل واحد يعامل ضميره وهو بيدوس علي الموافقه ولان حماية الاكسيل ضعيفه ظهر تحويل الملف لملف تنفيذي لحماية افضل فبردو ظهر الرخم ياسر اللي هو انا وقالهم الملفات التنفيذية تعبانه وياريت تتابع الموضوع الاتي لتعرف اكتر http://www.officena.net/ib/topic/65613-قاهر-الملفات-التنفيذية-واستخراج-الملف-الاصلي/ ولما احبط الناس قلت لازم نخدمهم فعملت كدا http://www.officena.net/ib/topic/65615-أفضل-حماية-للاكسيل-تفوق-التحويل-الى-ملفات-تنفيذية-100مرة/ وبعدين كدا http://www.officena.net/ib/topic/65946-اختبار-مدى-حماية-الملف-التنفيذي-للفيجوال6-مع-الاكسيل/ وياريت اكون وفيت الشرح وعتابك فوق راسنا وانت اكيد من الاحباب والاخوة الافاضل ولكن ستفهمني بعد قراءةموضوع قاهر الملفات تقبل تحياتي

أخي الحبيب عبد العزيز السر في الاسم (يا سر ...) تقبل وافر تقديري واحترامي

أخى ياسر بجد والله أنا اقف مبهورا أمام ابداعاتك لأتعلم منها وفعلا فكرة جميلة فكرة النقاش لتبادل الخبرات وبالنسبة للكود ما رأيك فى هذا الاختصار Sub ragab() Set Sh = ورقة3 x = [g13] T = Application.Match(x, Sh.Columns("G:G"), 0) If Not IsNumeric(T) Then T = Sh.[G1000].End(xlUp).Row + 1 Sh.Range("B" & T).Resize(1, 10).Value = Range("B13").Resize(1, 10).Value End Sub

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

أخى الحبيب / ابراهيم جزاك الله كل خير على هذه الكلمات الطيبة والشعور الطيب والله المنتدى كله واحشنى جدا وربنا يديم المعروف والمودة

السلام عليكم اخي عمرو الملف يعمل دون مشاكل كل ما عليك تعبئة الخانات التي باللون الاحمر واحفظ الملف واغلاقه ومن ثم فتحه وسوف يقوم بارسال ايميل للتواريخ المنتهية. حاول واخبرني بالنتيجة الملف في المرفقات ehab new.rar

Private Sub txtQuant_AfterUpdate() If Me.txtQuant > Me.txtStock Then MsgBox "Le stock est insuffisant" غير كافي المخزون Me.txtQuant = Null Exit Sub End If سلام عليكم بخصوص ترك رسالة عن الكمية الموجودة في المخزن quant > stock

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

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

وتكون النتيجة كما بالملف المرفق spin.rar

وعليكم السلام أخي الغالي أبا الحسن والحسين إضافة لما تفضلت به في الملف المرفق من الكود ..إضافة بسيطة جداً لكي يعمل الكود على كلا النظامين 32 بت و64 بت (حيث أن الملف المرفق في المشاركة الخاصة بك سيعمل على 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 ليصبح الكود النهائي بهذا الشكل (الكود يوضع في حدث الفورم ) #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 Sub RemoveCaption(objForm As Object) Dim lStyle As Long Dim hMenu As Long Dim mhWndForm As Long If Val(Application.Version) < 9 Then mhWndForm = FindWindow("ThunderXFrame", objForm.Caption) 'XL97 Else mhWndForm = FindWindow("ThunderDFrame", objForm.Caption) 'XL2000+ End If lStyle = GetWindowLong(mhWndForm, -16) lStyle = lStyle And Not &HC00000 SetWindowLong mhWndForm, -16, lStyle DrawMenuBar mhWndForm End Sub Private Sub CommandButton1_Click() Unload Me End Sub Private Sub UserForm_Initialize() Call RemoveCaption(Me) End Sub ونقطة أخيرة للاستفادة الكاملة من الكود يمكنك وضع الإعلانات العامة والإجراء المسمى RemoveCaption في موديول عادي ..بينما يوضع حدث زر الأمر وحدث بدء تشغيل الفورم في حدث الفورم أي يمكن الفصل بينهما تقبل تحياتي

بارك الله فيك

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

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

أستاذى الحبيب / عبد الله باقشير دائما أتشرف بمرور أستاذى الحبيب وكلماته المشجعة تقبل أرق تحياتى وتقديرى

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

وهاي كمان برامج ولسى الخير قادم أنا شايف إنو لغاية الآن ما في لسى حد دخل على المنتدى و هيك راح تكون مفاجئة كبيرة للكل WriteNumber2000.zip ProgressBar2000.zip ColorRecords2000.zip Keyboard2000.zip FindAndFilter2000.zip HideMsgBoxFail2000.zip Animation2k.zip

شوفولي هالبرامج إشي من الآخر بس والله حاب أسمع تعليقاتكم بدي دعمكم و لسى في كمان كثيييييييييييييييييييييييييييييييير FormsAndReports2000.zip PrintCurrentRecord2000.zip selectionfromcombobox2000.zip MsgBoxMove2000.zip Dialog.zip 2ListBox2000.zip Fatoorh2000.zip IIF2000.zip name2002.zip TreeView2000.zip

شوفولي هالبرنامج و إدعولي وما بدي أذكركم هاي برامج مجمعة من مواقع ومنتديات ، يعني مش أنا إلي عاملها وبشكر أصحاب هذه البرامج لأنها راح تكون مفيدة للجميع إنشاء الله wzbackup.zip

وهنا برامج أخرى ،،،،، لا تنسونا بالدعاء زي ما وصيتكم ، ، ، accarch179.zip accarch171.zip