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

السلام عليكم ورحمة الله وبركاته إخواني الكرام في المنتدى الحبيب سبق أن قدمت في موضوع سابق دالة مشابهة لدالة اليوم ، ولكن دالة اليوم مميزة من ناحية سنقوم بسردها بعد قليل رابط الموضوع المتعلق بشبيهة الدالة فاصل ونواصل (أصلي تعبت ... ) دا شكل الدالة المعرفة Function GetUnique(R As Range) Dim Cl As Range, J As Long With CreateObject("System.Collections.ArrayList") For Each Cl In R.Cells If Cl <> "" Then If Not .contains((Cl.Value)) Then .Add (Cl.Value) Next .Sort For J = 1 To R.Count .Add ("") Next J GetUnique = Application.Transpose(.toarray()) End With End Function ايه رأيكم في شكلها (أنا شايف إنها شكلها لطيف ...مش كدا يا أبو يوسف) تقوم الدالة المعرفة UDF والتي تسمى GetUnique ، باستخراج القيم الغير مكررة في نطاق أي القيم الفريدة في نطاق ، والجديد والمفيد أنه يمكن ترتيب القيم لتحصل في النهاية على قائمة منقحة ومصححة وخالية من التكرار والفراغات .. كل دا بضربة واحدة (ضربة معلم ..صح يا حوسو) إذاً وظيفة الدالة : الحصول على قيم فريدة اي غير مكررة - ترتيب النتائج ترتيب أبجدي - التخلص من الفراغات الموجودة في القائمة الأصلية وبالمثال المرفق سيتضح المقال كيفية عمل الدالة : بفرض أن القيم المراد استخراج القيم الفريدة منها في العمود الأول في النطاق A1:A30 نشوف العمود اللي عايزين نستخرج النتائج فيه وليكن العمود G .. اشمعنا العمود دا بالذات ، عشان العمود ده رقم 7 وأنا من عشاق الرقم 7 ومضاعفاته .. نحدد النطاق من أول الخلية G1 لحد G30 قبل ما نكتب المعادلة حددنا النطاق (برافو عليك يا حوسو) روح بقا لشريط المعادلات (مش ظاهر معاك يبقا أكيد لعبت في إعدادات الإكسيل .. ودي حاجة مش وحشة دي حاجة حلوة ، لأنها دليل إنك عايز تتعلم .. اظهر شريط المعادلات من التبويب View هتلاقي كلمة Formula Bar جنبه مربع علم عليه ..! مش أحسن ما هو اللي يعلم عليك) ضع المعادلة التالية في شريط المعادلات =GetUnique(A1:A30) ومن لوحة المفاتيح اضغط Ctrl + Shift + Enter لأن دي معادلة صفيف .. ومبروك عليك القايمة الجديدة (على أساس إنك متجوز للمرة التانية .. بس القديمة تحلا ولو كانت أحلى ..بلاش نقول وحلة لناخد مخالفة (من خاف سلم)) طيب دلوقتي أنا سامع واحد بيقولي إنت ليه بتجبرني إني أرتب القيم (أنا عايز القيم زي ما هي بدون تكرار وبدون فراغات بس الترتيب ميلزمنيش) .. أرد عليه وأقوله ولا تزعل نفسك يا حبيبي روح لمحرر الأكواد ودور على السطر اللي جاي ده واحذفه أو ضع بجانبة تعليق .. بس خلاص ! مش دي اللي هتزعلنا من بعضنا ) .Sort وأخيراً تقبلوا تحيات أخوكم أبو البراء دمتم على طاعة الله Get Unique UDF Function.rar

لعله لمطلوب find salim.rar

اخي مستر ستيف اتوقع لابد ان يكون اللغة موجودة لديك وهنا لاحظ في الريجيستري يوجد الانجليزي ! هل ممكن نحول للعربي الله اعلم هذا الشرح https://msdn.microsoft.com/en-us/library/hh362866%28v=office.14%29.aspx ولي عودة ان شاء الله تحياتي

اعزائي هذا كود رمهاني .. سريع مجاني ..! DoCmd.SetWarnings False Set rs = CurrentDb.OpenRecordset("vtb"): rs.MoveLast: rs.MoveFirst For i = 1 To rs.RecordCount Step 6 Set rs1 = CurrentDb.OpenRecordset("select * from vtb where id between " & i & " and " & i + 5 & " order by id"): rs1.MoveFirst Do While Not rs1.EOF xsql_val = xsql_val & "'" & rs1(1) & "'," rs1.MoveNext Loop xsql_val = Left(xsql_val, Len(xsql_val) - 1) DoCmd.RunSQL "insert into rtb(b1,b2,b3,b4,b5,b6) values(" & xsql_val & ")" xsql_val = "" Next i DoCmd.SetWarnings True اخي ابو منتظر : يمكنك تنفيذ الكود في اي مكان . مثلا خلف زر امر وعند النقر ! مع ملاحظة : لو نفذته اكثر من مرة سيكرر البيانات فيمكن وضع سطر واحد حذف سجلات الجدول قبل تنفيذ الكود ! تحياتي وبالتوفيق

السلام عليكم .. اولاً: جزاه الله خيراً جميع اعضاء المنتدى و القائمين عليه حيث ان كل خبرتي في الاكسل استفدتها من هذا المنتدى الرائع .. ثانياً: اهديكم هذا البرنامج المتواضع الخاص بالمخازن .. محتويات البرنامج: 1. مخازن 2. مشتريات 3. مبيعات 4. مرجع مشتريات 5. مرجع مبيعات 6. موردين (دائنون) 7. عملاء (مدينون) 8. سندات قبض (موردين , عملاء) 9. سندات صرف (موردين , عملاء) 10. مصروفات 11. خزينة مميزات البرنامج: سهولة الاستخدام حيث يمكن لأي شخص لا يفهم في المحاسبة استخدامه بكل اريحية يعتمد البرنامج بشكل عام على الاكواد سواء للاصناف او للموردين او للعملاء متابعة حركات الخزينة من مشتريات او مبيعات .. إلخ اعتماد المخزن على طريقة المتوسط المرجع وجود سندات قبض و سندات صرف سواء للموردين او العملاء امكانية اضافة المصاريف طريقة الاستخدام: في البداية يجب اضافة موردين و عملاء و اعطاء كود لكل مورد و كل عميل لاضافة فاتورة مشتريات: 1. التوجه للمخازن و اضافة كود الاصناف واسمها 2. التوجه للمشتريات و اضافة كود الاصناف و الاعداد و الاسعار و رقم المورد و الاختيار من القائمة المنسدلة اذا كانت الفاتورة نقدا او اجل في حال نسيان وضع الفاتورة نقدا او اجل سيتم اعتبارها اجل تلقائياً لاضافة فاتورة مبيعات: 1. التوجه للمخازن و اضافة كود الانصاف و اسمها 2. التوجه للمبيعات و اضافة كود الاصناف و الاعداد و الاسعار و رقم العميل و الاختيار من القائمة المنسدلة اذا كانت الفاتورة نقدا او اجل في حال نسيان وضع الفاتورة نقدا او اجل سيتم اعتبارها نقدا تلقائياً الخزينة: يجب وضع رصيد بداية المدة في الخزينة و هناك خانة للمسحوبات الشخصية و ان شاء الله يتم تطويرها في الاصدارات القادمة ملاحظة: 1. جميع ورق البرنامج محمية بدون كلمة سر ما عدا اول صفحة و يرجى عدم حذفها لو سمحتم 2. الاصدار في مرحلة التجربة (نسخة تجريبية) و غالباً هيكون في بعض الاخطاء البسيطة ان وجودت سيتم تعديلها ان شاء الله .. لو اي شخص وجد أي خطأ يرجى التنبيه و شكراً لكم التحميل: في المرفقات باسوورد فك الضغط: www.officena.net elnour.rar

أتمنى من الله ان تكونوا في تمام الصحة والعافية موضوع بسيط وجديد على البعض وفائدته أنه يعمل إنتقال من الفريمات الموجودة في اليوزر فورم بشكل غير تقليدي وسلس في المثال المرفق يوجد يوزر فورم وبه عدد 2 Frame ويتم الإنتقال من فريم للأخر بزر عادي ولكن طريقة الإنتقال هي موضوعنا الأكواد المستخدمة أكواد الـ UserForm يحتوي على 2 Command Button لإنتقال من فريم للأخر Option Explicit Private Sub CommandButton1_Click() While Frame2.Left > 6 Frame2.Left = Frame2.Left - 10 DoEvents Sleep 10 Wend End Sub Private Sub CommandButton2_Click() While Frame2.Left < 266 Frame2.Left = Frame2.Left + 10 DoEvents Sleep 10 Wend End Sub Private Sub UserForm_Initialize() Me.Width = 262 Frame2.Left = 266 Frame2.Top = 6 End Sub كود مستخدم في Module عادي Option Explicit Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) أتمنى يكون الموضوع خفيف وواضح والمرفق به التطبيق ودمتم في حفظ الله Sliding Form.rar

أحبائي المهتمين في منتدى الإكسيل.. أرفق إليكم طريقة تشغيل ملف اليوتيوب عن طريق الفورم الشرح في رابط الفيديو تشغيل اليوتيوب.rar

شهادة اعتز فيها استاذي العزيز

أخي الحبيب سعد .. ابقا اقرا وتابع الشرح كويس بعد كدا عشان أنا راعيت إني مفوتش حاجة ... لو اتكرر الأمر بعد كدا هنغرمك (عشا لكل الموجودين بالمنتدى) تقبل تحياتي

هاتفضل دائما وأبدا رائع أخى الحبيب الغالى / ياسر خليل جزاك الله كل الخير وأدام عليك الصحة والعافية

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

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

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

بارك الله فيك أخي الغالي علي الشيخ بعد إذنك هذه محاولة بدون أعمدة مساعدة جرب المعادلة التالية في الخلية C2 =IF(ISNA(MATCH(A2,$G$3:$G$8,0)),B2,0)

على فرض ان التاريخ في العامود 1 اكتب هذه المعادلة و اسحب نزولاً: =MONTH(A1)

السلام عليكم أخي أنا عملتهالك بطريقة بدائية شوية حطيت قصاد كل أرقام السيارات في العمود G القيمة 0 واستخدمت دالتي Vlookup و IFERROR بحيث ان كل أرقام السيارات في العمود A سيتم البحث عن كل قيمة في هذا العمود هل هي موجودة في العمود G ولا لا لو موجودة يجيب القيمة اللي قصادها وهي 0 اللي اضفناه في الخطوة السابقة لو مش موجودة هيكتب القيمة من العمود B والدالة المستخدمة كالتلي =IFERROR(VLOOKUP(A3,$G$3:$H$8,2,FALSE),B3) والمرفق يوضح أكثر ان شاء الله لحد ما يدخل الإخوة ويقدموا حلول أفضل بإذن الله find.rar

السلام عليكم اولا ، اللي اوله شرط ، آخره نور انا ما عندي الاكسس 64 بت ، وما عندي تجربة في الموضوع ، لكني اتذكر ان اختنا الفاضلة الدكتورة أم عهود (حفظها الله اينما كانت) ، كان لها اجابة لهذا الموضوع ، فانا هنا ساعي بريد ، اكتب لكم بالضبط ما كتبته هي في منتدى الفريق العربي للبرمجة ، والشرط هنا ، اني قد لا استطيع مساعدتكم للنهاية ، لأني لا املك اكسس 64 بت والظاهر هنا ، ان الشئ الوحيد الذي يختلف فيه 64 بت عن 32 بت هو في بعض اوامر الكود والوحدات النمطية التي تنادي user32 مثلا ، اي انها 32 بت. والان من هنا ورايح هي مشاركة اختنا الفاضلة زهرة: في حالة وجود اكثر من وحدة نمطية بها Declare فإننا سوف نضع مثل هذا الكود في كل وحده نمطية على حده لتعمل على النظامين 32 بت و 64 بت وطبعا تختلف التصاريح من وحده نمطية والأخرى عن بعضها البعض #If Win64 Then Private Declare PtrSafe Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #Else Private Declare Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #End If دالة تحجيم النموذج بعد التعديل Option Compare Database #If Win64 Then Private Declare PtrSafe Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #Else Private Declare Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #End If Public Function resizefrom(frm As Form, bestw As Integer, besth As Integer) On Error Resume Next wrate = DisplaySize(0) / bestw hrate = DisplaySize(1) / besth frm.InsideWidth = frm.InsideWidth * wrate frm.InsideHeight = frm.InsideHeight * hrate Dim fc As Control For Each fc In frm.Controls fc.Top = fc.Top * hrate fc.Left = fc.Left * wrate fc.Width = fc.Width * wrate fc.Height = fc.Height * hrate fc.FontSize = fc.FontSize * wrate Next End Function اما الوحدات النمطية التي ليس بها Declare فتبقى كما هي بدون اي تغيير ملاحظة هامة للفهم عند اضافة PtrSafe فإنها تحتاج ايضا الى تعديل بعض المؤشرات Long تتغير الى LongPtr مثال Dim lStructSize As LongPtr دالة ()Len تتغير الى ()LenB حتى يتم قبولها في نظام 64 فقط مثال tsFN.lStructSize = LenB(tsFN) بقية المؤشرات مثل String و Boolean فإنها تبقى كما هي بدون تغيير راجع المصدر https://msdn.microsoft.com/en-us/library/office/gg264421.aspx بالتوفيق

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

المهم اللي يسبق وعلى رأي المثل الأوفيسني (اللي يسبق ياخد أفضل إجابة) ههههههه تقبل تحياتي

أخي الحبيب صلاح يتم استخدم الكلمة Call ثم اسم الإجراء الفرعي المراد تنفيذه Call MyMacro حيث أن MyMacro اسم الإجراء الفرعي المراد تنفيذه عند فتح المصنف

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

الاخ ياسر لقد قمت بالتعديل على المعادلة كالتالي Sub ConvertFormulaToVBA() Dim I As Long Application.ScreenUpdating = False For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row Cells(I, 3) = (Cells(I, 2) - Cells(I, 1)) / Cells(I, 1) Next I Application.ScreenUpdating = True End Sub هل هذا التعديل صحيح حسب فهم المعادلة اعلاه

ترحيل بيانات بالقائمة المنسدلة للعلامه عبد الله باقشير والمرفق يوضح اكثر ترحيل عن طريق القائمة المنسدله.rar

السلام عليكم أخي أبو البراء الغالي: الله يسعد جميع أوقاتك صباحها ومساءها...بنور الإيمان

في أسفل كل مشاركة تجد كلمة "تحديد كأفضل إجابة" قم باختيار أفضل إجابة لك وانقر على الكلمة .. ومتنساش اسم الظهور للغة العربية لمعرفة كافة ما يرتبط بالتعامل مع المنتدى راجع الرابط التالي (ويا ريت كل الأخوة الجدد يطلعوا على الرابط ... للضرروة) http://www.officena.net/ib/index.php?showtopic=60147

الاجابة التى كنت اود ان اجدها وجدتها فى اجابة اخى اسلام ابو جومانة باستخدام دالة offset

الأخ الفاضل astika أما آن لك أن تقوم بتغيير اسم الظهور للغة العربية يرجى تحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي تقبل تحياتي

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

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

عملية البطء سببها الدوارة الداخلية والسرعة زادت الضعف تقريبا عندما استبدلتها Do While Not Rst.EOF Rst1.Fields(m) = Rst.Fields(0) m = m + 1 Rst.MoveNext Loop حين استبدلتها بهذه For p = 1 To n Rst1.Fields(m) = Rst.Fields(0) m = m + 1 Rst.MoveNext Next p

من الافضل ان ترفق طلبك ليتسنى للإخوة أساتذتنا الكرام الاطلاع ومعرفة سبب التكرار

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

بعد إذن أخى" سليم " وجزاكم الله على كل مجهودكم التى تبذلوة فى المنتدى ولأخى السائل أستخدم هذه الصيغة بفرض أن البيانات فى الخلية " A1 " إستخدم هذه الصيغة وأسحبها لأسفل ستحقق المطلوب بإذن الله =ROUNDDOWN(A1/0.5,0)*0.5 تقبلوا تحياتى تقريب رقم.rar

أخي الفاضل إليك الملف التالي على قدر فهمي .. ويا ريت الأخوة المحاسبين يفيدونا لأنهم أكثر دراية مني بالأمر Sub GrabDataFromSheets() Dim WS As Worksheet, SH As Worksheet Dim Cell As Range Dim X As Long X = 7 Set SH = Sheets("كشف حساب") Application.ScreenUpdating = False SH.Range("B7:E1000").ClearContents For Each WS In ThisWorkbook.Sheets If WS.Name = "المبيعات" Or WS.Name = "المشتريات" Then For Each Cell In WS.Range("C5:C" & WS.Cells(Rows.Count, 3).End(xlUp).Row) If Cell.Value = SH.Range("C3").Value Then SH.Cells(X, 2).Value = Cell.Offset(, -1).Value SH.Cells(X, 3).Value = Cell.Offset(, 1).Value If WS.Name = "المبيعات" Then SH.Cells(X, 4).Value = Cell.Offset(, 4).Value If WS.Name = "المشتريات" Then SH.Cells(X, 5).Value = Cell.Offset(, 4).Value X = X + 1 End If Next Cell End If Next WS Application.ScreenUpdating = True End Sub تقبل تحياتي Grab Data From Two Sheets YasserKhalil.rar

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

خلاص استبدل sum ب count

عارف إنك ممكن تكسل تقرا المشاركة اللي فاتت فعملت لك فيديو ع السريع تقبل تحياتي

لا تنشرها جزاك الله خير ... ادخل وحمل وستعرف !! جمعة مباركة اخواني الكرام اللهم صلي علي سيدنا ((( محمد ))) وعلي آله وصحبه اجمعين جمعة مباركة.rar

اخى الفاضل ازاى يعني لا يوجد كود، الكود لا يعمل من خلال زر أمر ... لكن بمجرد فتح الملف سيري ان كان تاريخ اليوم اكبر من التاريخ الذي حددته سيحذف بيانات الشيت .. غير ذلك يبقي الوضع كما هو عليه .... شاهد المرفق وعامة هذا هو الكود انشئ موديول جديد والصق به هذا الكود مع تغيير التاريخ للتاريخ الذي تريده Sub ClearSheet() Dim Ddate As Date Ddate = "28/02/2015" If Date > Ddate Then Sheet1.Cells.ClearContents End If End Sub وفي حدث فتح الملف الصق هذا السطر Private Sub Workbook_Open() ClearSheet End Sub تحياتي Code.rar

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

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

ملحق الدرس الرابع الخاص بالرسائل نستعرض هنا الرساله التى تحتوى على مربع ادخال بيان قد يكون اسم ما وقد يكون كلمه سر للدخول فيما يختص بالجزئية الأولى يكون كود الرساله بهذا الشكل وهذا الكود على سبيل المثال Sub example() Dim result As String result = InputBox("Text?", "Title") If result <> "" Then End If End Sub فتكون الرساله بهذا الشكل كما بالصورة التالية وإذا أفترضنا أننا نريد أن يجعل الاكسل يظهر الاسم او الكلمه التى ستكتب داخل هذا المربع فيكون الكود بهذا الشكل Sub example_1 () Dim result As String ("result = InputBox("Text ?", "Title", "write the name If result <> "" Then MsgBox result End If End Sub الاختلاف بين الكودين فى اضافة هذه الجملة Msgbox result وهى تعنى ظهور رساله تاليه بها الجملة التى تم ادخالها بالمربع فتظهر الرساله كما بالصورتيين التاليتين بعد كتابه الاسم على سبيل المثال تظهر الرساله بالشكل التالى نأتى لجزئية كلمة السر لقد جعلت الكود خاص بالمثال العملى المرفق يختص بالدخول الى الشيت الثانى وقد سجلت الكود بمحرر الأكواد الخاص بحدث الشيت الثانى أى داخل الصفحه نفسها من خلال الفيجوال بيسك وان شاء الرحمن سوف نتطرق لأمر الأكواد بشىء من التفصيل فى الدروس القادمة وما هو الفرق بين الكود داخل موديول أو بحدث الشيت أو بحدث المصنف بالكامل والكود الخاص برساله كلمه السر كالتالى Private Sub Worksheet_Activate() xx: Dim x x = InputBox("Password required" & Chr(13) & "يلزم معرفة كلمة السر للدخول لهذه الصفحه ", "فضلاً أدخل كلمة السر") If IsNull(x) Or x = "" Then GoTo xx If x = "بسم الله" Then MsgBox "كلمة السر تم قبولها تفضل لتنفيذ العمليه" Else MsgBox "Wrong Password" & Chr(13) & " عفواً لم تدخل كلمة السر الصحيحه سيتم العوده بك للصفحة الرئيسيه !!", vbOKOnly Sheets("sheet1").Activate End If End Sub فعند محاولة الدخول للشيت الثانى تظهر لنا الرساله كما بالصورة التالية وعند كتابة كلمه السر وهى بسم الله بين الكلمتين مسافة واحده فقط تظهر لنا رساله بهذا الشكل وبالضغط على زر OK يتم الدخول الى الشيت الثانى فى حال كوننا لم ندخل كلمه السر الصحيحة تظهر لنا رساله توضح ذلك وتنتقل مباشرة الى الشيت الأول والرساله كما بالشكل التالى مرفق ملفين الأول ملحق الدرس الرابع PDF الثانى مثال عملى لما ورد بالدرس وتقبلوا منى وافر الاحترام والتقدير ملحق الدرس4.rar مثال عملى ملحق الدرس 4.rar

واصل ابداعاتك اخى الكريم . جمعة مباركة

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

السلام عليكم سررة بمرورك العطر جازاك الله خيرا تقبل مني تحياتي

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

الكود التالي يعيد كافة القيم الإفتراضية لحقول النموذج ، وكأننا ننتقل لسجل جديد ... Private Sub btnClear_Click() Dim ctl As Control On Error Resume Next For Each ctl In Me.Controls ctl.Value = ctl.DefaultValue Next Set ctl = Nothing End Sub والسلام ختام

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

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