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

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

جرب ذلك لعله يكون المطلوب تحياتي اضافة.rar

بسم الله الرحمن الرحيم الحمد لله فقد انتهيت من اعداد النسخه الاولى من برنامج للحسابات باربعة مستويات البرنامج يعمل بدليل للحسابات--ومراكز التكلفه--واسعار صرف للعملات يرجى من الاخوه الخبراء والاعضاء تقيم البرنامج بشكل جيد ان شاء الله يتم تحديث البرنامج مرفق شكل البرنامج وكيفية العمل عليه ACC PRO-first edittion.rar تقبلوا تحياتى

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

السلام عليكم و رحمة الله و بركاته بارك الله في حضراتكم و اصبحكم و امساكم بكل خير

تفضل حبيبي

وعليكم السلام استعملت: ---------------------------------------------- 3. اعمل وحدة نمطية ، مثلا function make_shortcut() الكود يأتي هنا end function ثم اعمل ماكرو ، واطلب من الماكرو ان: شغل الكود make_shortcut شغل النموذج الفلاني ---------------------------------------------- فك المرفق في مجلد واحد ، وافتح البرنامج بطريقة عادية ، واغلق البرنامج ، سترى الاختصار على سطح المكتب ، ومن الان فصاعدا استخدمه للدخول لبرنامجك وكلما حذفت الاختصار ، سيتكون من جديد جعفر Export to Excel And Make Dektop shortcut.zip

اي ID شغال دوس اي حاجه اخي الغالي مش بيقول لا تمام مثل ما ذكر اخي الغالي ابراهيم

اخى محمد جرب ملئ الخانات باى رقم حتى يتم تنشيط زر التالى انا شخصيا عملت كده ومش عارف اذا كان ده الصح ولا ايه ولكن مشيت الطريقه معايا اه والله كتبت 99999999999 تقبل تحياتى

السلام عليكم اخي الكريم شاهد المرفق كشف حساب العميل تعديل1.rar

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

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

تفضل اخر الكريم جرب البرنامج التالى لو عجبك ارسلك نسخه 2016 المستخدم الدعم الفنى الباسورد 123 ( يمكنك تغيير بنفسك ) تقبل تحياتى برنامج EMA 2015م.zip

إخواني الكرام في المنتدى الغالي أقدم لكم اليوم موضوع ليس بالجديد ولكنه جد مفيد (جد .. يعني جداً أوك يا جدو) ..أقصد مفيد جداً الموضوع يتمحور ويتمركز حول معرفة الأرقام المفقودة أو الأرقام الناقصة في سلسلة أرقام .. إليكم الكود الأول المؤدي للغرض (هنا يشترط ترتيب الأرقام) ، مع شرح تفصيلي لأسطر الكود لتتمكن من التعديل عليه Sub MissingNumber_NumbersSorted() 'يقوم الكود بإظهار الأرقام الناقصة في تسلسل معين للأرقام ويشترط ترتيب الأرقام '------------------------------------------------------------------------- Dim SH As Worksheet Dim LR As Long Dim Text As String Dim I As Long, X As Long, XX As Long '[Sheet1] تخصيص المتغير ليساوي ورقة العمل المسماة Set SH = Sheets("Sheet1") 'تحديد آخر صف به بيانات في العمود الأول LR = SH.Cells(SH.Rows.Count, 1).End(xlUp).Row 'حلقة تكرارية بداية من الصف الخامس وحتى آخر صف به بيانات في العمود الأول For I = 5 To LR 'يساوي الفرق بين قيمة الخلية التالية وقيمة الخلية الحالية في الصف المحدد [X] المتغير X = Val(SH.Range("A" & I + 1)) - Val(SH.Range("A" & I)) '[X] استخدام الجملة الشرطية لناتج المتغير Select Case X 'إذا كان الفرق بين قيمة الخليتين أكبر من 1 يتم تنفيذ الحلقة التكرارية ما بين السطرين Case Is > 1 'حلقة تكرارية لتخزين الأرقام الناقصة For XX = 2 To X 'يساوي المتغير نفسه مع قيمة الخلية الحالية مضاف إليها قيمة المتغير في الحلقة التكرارية ناقص واحد ثم سطر جديد[Text]المتغير المسمى 'مثال لفهم هذا السطر '------------------- 'توجد القيمة 50012 [A15] توجد القيمة 50009 وفي الخلية [A14] في الخلية 'بما أن الفرق بين الخليتين يساوي 3 إذاً سيتم تنفيذ الحلقة التكرارية 'بداية الحلقة التكرارية 2 حيث أن رقم 2 هو أول رقم أكبر من واحد ، وفي مثالنا نهاية الحلقة التكرارية تساوي 3 'المتغير المفترض تخزين الأرقام الناقصة فيه عبارة عن سلسلة نصية فيتم إضافة النصوص التي سبق استخراجها ثم إضافة النصوص الجديدة 'الأرقام الناقصة تساوي قيمة الخلية الحالية 50009 في المثال مضافاً إليها قيمة الحلقة التكرارية والتي هنا تساوي 2 في بداية الحلقة التكرارية ليصبح الناتج 50011 ثم ناقص واحد لتحصل على أول رقم ناقص ألا وهو 5010 'يساوي 3 لتحصل في النهاية على الرقم التالي الناقص ألا وهو 5011[XX]مع الانتقال في الحلقة التكرارية يصبح المتغير Text = Text & Val(SH.Range("A" & I)) + XX - 1 & vbCrLf Next End Select Next 'رسالة لإظهار الأرقام الناقصة MsgBox Text, vbMsgBoxRtlReading End Sub وإليكم الكود الثاني وهو أقوى في أنه لا يشترط ترتيب الأرقام Sub MissingNumbers_YK_A() 'يقوم الكود باستخراج الأرقام الناقصة من سلسلة من الأرقام ولا يشترط ترتيب الأرقام '---------------------------------------------------------------------------- Dim InputRange As Range, OutputRange As Range, ValueFound As Range Dim LowerVal As Single, UpperVal As Single, Count_I As Single, Count_J As Single Dim NumRows As Long, NumColumns As Long Dim Horizontal As Boolean On Error GoTo ErrorHandler 'النطاق الذي يحتوي سلسلة الأرقام المراد استخراج الأرقام الناقصة منها Set InputRange = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) LowerVal = WorksheetFunction.Min(InputRange) UpperVal = WorksheetFunction.Max(InputRange) Horizontal = False 'بداية النطاق الذي سيتم استخراج النتائج به Set OutputRange = Range("E2") NumRows = OutputRange.Rows.Count NumColumns = OutputRange.Columns.Count Application.ScreenUpdating = False If NumRows < NumColumns Then Horizontal = True NumRows = 1 Else NumColumns = 1 End If Count_J = 1 For Count_I = LowerVal To UpperVal Set ValueFound = InputRange.Find(Count_I, LookIn:=xlValues, LookAt:=xlWhole) If ValueFound Is Nothing Then If Horizontal Then OutputRange.Cells(NumRows, Count_J).Value = Count_I Count_J = Count_J + 1 Else OutputRange.Cells(Count_J, NumColumns).Value = Count_I Count_J = Count_J + 1 End If End If Next Count_I Application.ScreenUpdating = True Exit Sub ErrorHandler: End Sub كما تمت إضافة حل بمعادلات الصفيف لتؤدي نفس الغرض وإليكم أيضاً كود رائع للأخ الحبيب سليم حاصبيا مع شرح للأسطر ولا يشترط الترتيب للأرقام أيضاً Sub MissingNumbers_SALIM() 'يقوم الكود باستخراج الأرقام الناقصة في سلسلة أرقام ولا يشترط الترتيب '------------------------------------------------------------------ 'تعريف المتغيرات Dim Dico, D Dim C As Range, Rng As Range Dim B As Long, I As Long Dim MinVal As Double, MaxVal As Double 'النطاق المراد استخراج الأرقام الناقصة منه Set Rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) 'سطر لايجاد أقل قيمة رقمية في النطاق MinVal = Application.WorksheetFunction.Min(Rng) 'سطر لايجاد أكبر قيمة رقمية في النطاق MaxVal = Application.WorksheetFunction.Max(Rng) 'مسح محتويات النطاق الذي سيتم استخراج النتائج به Range("G2", Range("G2").End(xlDown)).ClearContents 'إنشاء متغير من النوع كائن لتخزين الأرقام الناقصة به Set Dico = CreateObject("Scripting.Dictionary") 'حلقة تكرارية لكل الأرقام المسلسلة For I = 1 To (MaxVal - MinVal + 1) 'تعتمد هذه الأسطر على إضافة الرقم الناقص إلى الكائن المخصص لذلك If Application.WorksheetFunction.CountIf(Rng, MinVal + I - 1) = Then If Not Dico.Exists(MinVal + I - 1) Then Dico.Add (MinVal + I - 1), (MinVal + I - 1) End If Next I 'رقم صف البداية للنتائج في العمود السابع B = 2 'حلقة تكرارية لوضع القيم التي تم تخزينها في النطاق المحدد For Each D In Dico.items Range("G" & B) = D B = B + 1 Next D End Sub وعشان عيون أحبابي إليكم الكود الرابع وهو أفضل الأكواد من حيث أنه لا يشترط ترتيب الأرقام وأسطر الكود سهلة الفهم وسهلة التعامل معها Sub MissingNumbers_YK_B() 'يقوم الكود باستخراج الأرقام الناقصة في تسلسل للأرقام ولا يشترط الترتيب '------------------------------------------------------------------- 'تعريف المتغيرات Dim InputRange As Range Dim X As Long, lRow As Long 'تعيين النطاق الذي سيحتوي على سلسلة الأرقام المراد استخراج الأرقام الناقصة منها Set InputRange = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) 'مسح محتويات النطاق الذي سيتم استخراج النتائج به Range("I2:I1000").ClearContents 'حلقة تكرارية من أقل قيمة بالنطاق لأكبر قيمة بالنطاق For X = WorksheetFunction.Min(InputRange) To WorksheetFunction.Max(InputRange) 'استخدام دالة البحث فإذا كانت القيمة المراد البحث عنها غير موجودة يعطي خطأ 'وبناءً على الخطأ يتم تنفيذ السطر التالي If IsError(Application.Match(X, InputRange, )) Then '[I] الرقم 2 هو رقم صف البداية في العمود '[I] يتم وضع الرقم الناقص في الخلية في الصف المحدد في العمود Cells(lRow + 2, "I") = X 'زيادة المتغير بمقدار واحد للانتقال لصف جديد لإدراج الأرقام الناقصة lRow = lRow + 1 End If Next X End Sub أترككم مع الملف المرفق ...للاستفادة بشكل عملي بالكود كان معكم أخوكم ياسر خليل أبو البراء YK (الموضوع مهدى للأخ الحبيب والأستاذ الكبير أسامة البراوي OB ومهدى للأخ الفاضل نايف - م) حمل الملف من هنا تقبلوا تحياتي

السلام عليكم ورحمة الله وبركاته هذا الموضوع اُثير اكثر من مرة في الآونة الاخيرة ، ورأيت من الافضل ان اضع مثال ليقتدي به الجميع وقبل ان نبدأ ، اود ان اشير الى انني اعمل على اكسس 32 بت ، ولا املك نسخة من اكسس 64 بت احب ان اشير الى الرابط الذي شرحت فيه ان مايكروسوفت توصي بتنصيب الاوفيس / اكسس 32 بت ، بغض النظر عن نوع الوندوز المنصّب على الكمبيوتر ، سواء كان 32 بت او 64 بت: http://www.officena.net/ib/topic/64036-هل-استخدم-اوفيس-32-بت-او-64-بت/ ولكن ، ماذا نفعل اذا عملنا برنامجنا على اكسس 32 بت ، واتضح ان الزبون عنده جهاز فيه اكسس 64 بت المثال التالي يشتغل على 32 بت و 64 بت ، ونستطيع ان نستفيد منه لعمل برنامجنا البرنامج المرفق ، بعد فك الضغط ، سيحتوي على 3 برامج: . هذا برنامج No_Password_BE.accdb ، وبه جدول واحد ، ولا يحتاج الى كلمة سر لفتحه: . هذا برنامج Password_is_jj_BE.accdb ، وبه جدول واحد ، وكلمة السر لفتحه هي jj: . البرنامج: JStreetAccessRelinker2.accdb من الرابط http://www.jstreettech.com/downloads.aspx ، وبه ماكرو ووحدات نمطية تعمل على 32 بت و 64 بت (فالفضل في هذا المثال يعود للبرنامج وليس لي ) ، وقد قمت بإضافة نموذج لربطه مع احد برنامج الجداول اعلاه ، ومبدئيا فهو مرتبط مع البرنامج No_Password_BE.accdb ، . وعند فتح البرنامج لأول مرة ، سوف يفتح نافذة تطلب معرفة مكان برنامج الجداول No_Password_BE.accdb ، وتستطيع ان تنقر على الزر Link Another BE ، وستفتح لك نافذة تطلب منك معرفة مكان برنامج الجداول الجديد الذي تريد ان تربطه (بدل البرنامج No_Password_BE.accdb) : . وبما ان البرنامج هذا محمي بكلمة سر ، فسوف تظهر لك نافذة لإدخال كلمة السر (لاحظ ان الادخال مشفر) : . وعندما يتم الربط ، سترى رسالة التاكيد: . الرجاء من الشباب الذين لديهم نسخة من الاكسس 64 بت ، التاكد من ان البرنامج يشتغل على كمبيوترهم بدون اخطاء. عندما نريد ان نعمل برنامج يشتغل على النسختين 32 و 64 بت ، فكود النماذج هو نفسه بين نسختي 32 بت و 64 بت ، والشئ الوحيد الذي يتغير هو دوال الوحدات النمطية API ، والكود الذي ينادي هذه الوحدات (بغض النظر سواء كان في نموذج او في وحدة نمطية مستقلة) ، هنا سوف اعطي مثال واحد من الكود عن طريقة العمل للنسختين 32 و 64 بت: الكود التالي يستعمل دالة API فتح نافذة اختيار ملف ، والدالة هي 32 بت (لاحظ comdlg32.dll ) : Private Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long الان اذا اردنا ان نجعل هذه الداله API تعمل على 64 بت كذلك ، فالكود يجب ان يكون: #If VBA7 Then 'هذه لنسخة 64 بت Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Boolean #Else 'وهذه لنسخة 32 بت Private Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long #End If ولاحظ في كود البرنامج ، انه تم جمع جميع الدوال مع بعض ، وجمعها في if# و else# و end if# واحدة. وهناك اصدار جديد لكود الربط ، ويمكن انزاله من هنا: http://www.jstreettech.com/files/JStreetAccessRelinker2.zip جعفر 238.Work_on_32Bits_and_64Bits.zip

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

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

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

شكرا علي الاضافة يامعلم وائل انا قلت الاضافة ملف انت عملته بقي انما كدا هتخلي الناس هنا تهيج وتكتر الاسئلة عايزين نعمل مواضيع بقي

جزاك الله خيرا اخى الكريم فعلا هذا هو المطلوب

تفضل التاريخ التاريخ.rar

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

السّلام عليكم و رحمة الله و بركاته عزيزي الغالي " وائل الأسيوطي " .. إسألْ مجرّبْ و لا تسألْ طبيبْ .. عليك بالوصفة السحريّة ذات المفعول الشّافي و الكافي ..في العيادة على العنوان التالي : http://www.officena.net/ib/topic/65630-%D8%A7%D9%84%D8%B1%D8%AF%D9%88%D8%AF-%D9%88%D8%A7%D9%84%D8%A7%D8%B3%D8%AA%D9%81%D8%B3%D8%A7%D8%B1%D8%A7%D8%AA-%D8%B9%D9%86-%D8%AF%D8%B1%D9%88%D8%B3-%D8%A7%D9%84%D9%81%D9%8A%D8%AC%D9%88%D8%A7%D9%84-%D8%A8%D9%8A%D8%B3%D9%836-%D9%88%D8%A7%D9%84%D8%A7%D9%83%D8%B3%D9%8A%D9%84-%D9%8A%D8%A7%D8%B3%D8%B1-%D8%A7%D9%84%D8%B9%D8%B1%D8%A8%D9%8A/?page=5 فائق إحتراماتي

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

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

اللي يريحك

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

شكرا جزيلا على الرد أخي "عبد العزيز" وآسف ان كنت خالفت قواعد المنتدى عن غير قصد شكرا مرة ثانية فائق إحتراماتي

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

السّلام عليكم و رحمة الله و بركاته معذرةً أستاذي القدير " ياسر العربي " .. قدّمت إقتراح لهذا الموضوع الذي بغير محلّه بنفس الوقت معك بموضوع آخر مستقل .. لم أنتبه لذلك إلاّ بدخولي لسلسلة المناقشات بموضوعنا الشّامل فائق إحتراماتي

السّلام عليكم و رحمة الله و بركاته أخي الكريم "YES14" ..قمت بتغيير في الفورم و الكود .. محاولة بسيطة منّي على السّريع لعلّها تفي بالغرض .. ملاحظة : خالفتَ بتصرّفك قواعد المنتدى أخي الكريم فائق إحتراماتي جديد.rar

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

لو متابع جيد هتلاقي ان كاتب لو الايقونات اكبر من ٣٢bit كعمق الوان لن تضاف ارجع لايقونات اقل شويةاو تشوف برامج تحويل الايقونات هي بالفعل 32 رأيتها الان ولكن يوجد بعض الايقونات التي لا تعمل مع الفيجوال يرجى البحث عن ايقونات بديلة او برامج لتحويل الايقونات

تفضل استاذنا الغالي ابراهيم ابو ليله خصائص مباشرة لا انما ممكن تتعمل بكذا طريقة بالاكواد منها علي سبيل المثال (مرفق) والتنقل بين الازرار اما بالتاب او بالاسهم عادي ولا شئ مستحيل في الفيجوال :) New folder.rar

ربنا يحفظك ويبارك فيك ماقصرت كفيت ووفيت

ماقصرت تشكر ربنا يحفظك

معلش العتب على نظرى تقبل تحياتى

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

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

السلام عليكم البرنامج عند إعداده set Up يطلب product ID ولا أدري كيف أضعه وهو غير كلمة المرور التي ذكرتها.. تقبل تحياتي.

حبيت انبه اخي جعفر بان المسؤول عن كشف نوع الاوفيس من ناحية 32 بت او 64 بت هو التعبير التالي : #If Win64 Then ' Win64 #Else ' win 32 #End If وليس vba7 فهذه لكشف اصدار محرر الفيجول بيسك والذي سيعتبر لكشف اصدار الاوفيس حيث 7 تشير لاوفيس 2010 وما فوق ! هذا وسيكون لي محاولة وبموضوع جديد حول الاصدارين 32 بت و 64 بت الفرق والاعتبارات ! تحياتي للجميع

السلام عليكم ورحمة الله اخي كاسر الامواج متأسفين جدا لطول إنتظارك وجبر الخواطر علي الله تفضل إليك الملف 1- تم إلغاء التعديل بالكامل وتعليق الإضافة بعدم ظهور زر الجديد 2- تم إضافة العمود الرابع 3- يتم عمل البحث بواسطة إسم المنطقـــــــــــــــــــــــــــــــــــــــــــــــــة عن طريق الكمبوبكس 4- البحث بإختيار اسم المنطقة من الكمبوبكس وتستطيع الكتابة يدويا بس تنتبه فالبحث حساس جدا لانة يعمل مقارنة لكي يحدد الشيت ثم الصف ثم الخلية التي تقابل مابحثت عنة لذلك قمت بإستبدال التكست بكس بالكمبوبكس واسندت إلية اسماء المناطق لكي يكون دقيق في المقارنة تستطيع سجلات جديدة حتى الف إسم بعد البحث يقوم بنقلك الي عنوان الويب اخوكم في الله / ابو الحسن والحسين KHMB ادخال بيانات.rar

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

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

يجب ان يوضع الكود بهذه الصيغة Sub set_active_sheet() Dim sa As Worksheet If ActiveSheet.Name = "sheet1" Then Set sa = Sheets("sheet1") Else Set sa = Sheets("sheet2") End If sa.Activate lr = ActiveSheet.Cells(Rows.Count, 1).End(3).Row End Sub

السلام عليكم انسخ الكود التالي الى حدث الورقة المسماه "الصفحة 2" Private Const My_Rng_Adrs As String = "$A$3:$D$55000" Private Const Area_Prnt As String = "$C$7:$E$15" Dim Ar_1() As Variant Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Range("A7:A1000"), Target) Is Nothing Then MsgBox "" If Target <> Empty Then Dim Wr As Worksheet: Set Wr = Sheets("الصفحة 3") With Wr .Cells(7, 4) = Target .Cells(8, 4) = Target.Offset(0, 1) .Cells(9, 4) = Target.Offset(0, 2) .PageSetup.PrintArea = Area_Prnt .PrintPreview .Cells(7, 4) = "": .Cells(8, 4) = "": .Cells(9, 4) = "" End With Cancel = False Set Wr = Nothing End If End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$5" Then Range(Range("A7"), Range("D7").End(xlDown).Resize(1, 4)).ClearContents If Ali_Serch(CStr(Target), 1) = True Then Range("A7").Resize(UBound(Ar_1, 1), UBound(Ar_1, 2)) = Ar_1() End If Erase Ar_1 End If If Target.Address = "$C$5" Then Range(Range("A7"), Range("D7").End(xlDown).Resize(1, 4)).ClearContents If Ali_Serch(CDate(Target), 3) = True Then Range("A7").Resize(UBound(Ar_1, 1), UBound(Ar_1, 2)) = Ar_1() End If Erase Ar_1 End If If Target.Address = "$E$5" Then Range(Range("A7"), Range("D7").End(xlDown).Resize(1, 4)).ClearContents If Ali_Serch(CStr(Target), 4) = True Then Range("A7").Resize(UBound(Ar_1, 1), UBound(Ar_1, 2)) = Ar_1() End If Erase Ar_1 End If End Sub Private Function Ali_Serch(Trget As String, Col As Long) As Boolean Dim Ar Dim Rng As Range Dim C, x, i, XX, Xi, Xt Dim Data_1 Dim Wrsh As Worksheet Set Wrsh = Sheets("الصفحة 01") With Wrsh If Col = 3 And Not IsDate(Trget) Then MsgBox "صيغة التاريخ التي كتبتها غير صحيحه !!", vbExclamation, "إدخال خاطئ !!": Exit Function Set Rng = .Range(My_Rng_Adrs) Ar = Rng.Value ReDim Preserve Ar_1(1 To Rng.Rows.Count, 1 To 4) For x = LBound(Ar, 1) To UBound(Ar, 1) XX = Ar(x, Col): Xi = Trim(Ar(x, 1)): Xt = Trim(Ar(x, 2)) If Col = 3 Or Col = 4 Then Data_1 = Val(XX) ElseIf Col = 1 Then Data_1 = CStr(Xi & " " & Xt) ElseIf Col = 3 Then Data_1 = CDate(DateSerial(Year(XX), Month(XX), Day(XX))) End If If Not Data_1 = Empty Then If Data_1 Like Trget Then Ali_Serch = True i = i + 1 For C = 1 To 4 Ar_1(i, C) = IIf(C = 3, Format(Ar(x, C), "dd/mm/yy"), CStr(Ar(x, C))) Debug.Print Ar(x, C) Next C End If End If Next x End With Set Rng = Nothing: Set Wrsh = Nothing End Function بعد كتابة الاسم او التاريخ او رقم التسجيل اضغط انتر ستظهر النتائج اسفل جدول البحث انقر مرتين على نتيجة البحث في العمود "A" الاسم الاول سيطبع لك النتيجه جرب وابلغنا بالنتائج تحياتي تم اضافة المرفق وبه الكود اعلاه تجربة_111.rar

السلام عليكم تم عمل فورم لانشاء ورقة باسم الحساب يتضمن الاسم مع رقم الفرع علشان تكون التسمية والورقة على نسق واحد وتم عمل كود للترحيل شاهد المرفق 2010 الحسابات 1.rar

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

السلام عليكم يبدو ان هناك مشكلة حدثت للملفات في الترقية الجديدة ويارك الله فيك اخي ضاحي على مجهودك الطيب وهنا الملفات مرة اخرى الدرس الأول UserForm.rar الدرس الثاني.rar الدرس الثالث textbox.rar الدرس الرابع.rar الدرس الخامس.rar الدرس السادس.rar

السلام عليكم =========== انظر المرفق ترتيب تصاعدى وتنازلى بالمعادلات.rar