الحسامي

السلام عليكم اخي الكريم هنا محاولة قد تفيدك

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

السلام عليكم بارك الله فيك اخي ابو احمد اهم من معرفة الاكواد هو كيفية استخدامها والمنطقية باستخدامها لعمل اي برنامج وانت - والله بدون مجاملة- تسير في الاتجاه الصحيح واتوقع لك مستقبل اكثر من مبهر في عالم الاكسل ----------------------- وللفائدة هنا الكود صحيح بالكامل لكنه يقوم بالمقارنة في جميع الصفحات بما فيها الصفحة التي يوجد بها الزر اي ان قمت بشمول جميع الصفحات بلا استثناء بحيث لو كانت هناك بيانات في الصفحات التي لا نريد تنفيذ فيها الكود لحدثت مشاكل نوعا ما اذا كانت هذه البيانات في نفس اماكن البيانات في الصفحات المطلوب تنفيذ الكود بها ويمكننا التخلص من هذه المشكلة بعدة وسائل ونستطيع بناءا على الملف المرفق استثناء الصفحة الرابعة من الكود باضافة If x.Name <> "ورقة4" Then ---------------------------------------- ويمكننا استخدام الكود التالي وبنفس مبدأ الكود السابق تقريبا ليتم تنفيذه في اول 3 صفحات Dim c As Range For i = 1 To 3 For Each c In Sheets(i).[e4:e43] If c = Sheet4.[f2].Value Then c.Offset(0, 1) = Empty Next c Next i وهنا يعتمد ترتيب الصفحات بحيث تكون في اول 3 صفحات -------------------------------------------------- وهنا نفس المود لتحديد التاريخ من الى Dim c As Range For i = 1 To 3 For Each c In Sheets(i).[e4:e43] If c.Text >= Sheet4.[f2].Value And c.Text <= Sheet4.[f4].Value Then c.Offset(0, 1) = Empty Next c Next i --------------------------- اعذروني على تطفلي ولكن للفائدة والمعلومة مسح محتوى خليه بتاريخ.rar

السلام عليم يارك الله فيك يا عم الكل الدغيدي ومن بعد اذنك ------------------- لحذف السطر المطلوب يستخدم الكود التالي Rows([f1]).Delete ولمسح بيانات السطر يستخدم السطر التالي Rows([f1]) = Empty

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

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

السلام عليكم اخي الكريم هنا رابط لموضوع نقل فورم من ملف الى ملف اخر للحبيب خبور خير عسى ان يلبي طلبك نقل فورم من ملف الى ملف اخر

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

السلام عليكم عذرا اخي محمود فقد تم ارفاق الملف في المشاركة 2 بالخطأ الملف السابق يخص موضوع اخر لقد تم تعديل الملف في المشاركة السابقة

السلام عليكم الاخوة/ دغيدى ياسر الحافظ yahiaoui محمود علاء سعد عابد بارك الله فيكم على المرور وعلى كلامكم الطيب ورمضان كريم

السلام عليكم اخي علاء هنا الملف وفيه التعديل المطلوب وتم تغيير جميع الاكواد باكواد ابسط واسهل 0.rar

السلام عليكم بارك الله فيك يا عم الكل / الدغيدي وبارك الله فيك اخي محمود علاء ومن بعد اذنكم هنا نفس الملف وفيه التعديل المطلوب شئون عاملين1.rar

السلام عليكم اخي الكريم استخدم الكود التالي Dim x As Worksheet Application.ScreenUpdating = False For Each x In Application.Worksheets x.Range(Sheet4.Range("e16")) = Empty Next x حذف ما بداخل خليه.rar

السلام عليكم جهود متميزة من الجميع ولتنوع الحلول هنا ثلاثة طرق لثلاثة ادوات متنوعة كود اخفاء الصفوف 11.rar

السلام عليكم بارك الله فيكم حلول اكثر من رائعة ولتنوع الحلول هنا حل اخر بالاكواد Dim c As Range Sheet2.[g4:h24] = Empty For Each c In Sheet1.[g6:g26] If c = 1 Then Range(Sheet2.[g24].End(xlUp).Offset(1, 0), Sheet2. _ [g24].End(xlUp).Offset(1, 1)) = Range(c.Offset(0, 1), c.Offset(0, 2)).Value Next c Sheet1.[h5:i5] = Sheet2.[g25:h25].Value ترحيل بطريقة اخرى1.rar

السلام عليكم اخي الكريم هنا مرفق قد تجد فيه ضالتك قوائم.rar

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

السلام عليكم اخي الكريم لاثراء الموضوع وتعدد الحلول وبعد اذن المهندس طارق هنا حل اخر If Not Intersect(Target, [d18:f39,p18:p39]) Is Nothing Then On Error Resume Next Dim x As Integer x = Target.Row Cells(x, "o") = Application.WorksheetFunction.VLookup(sheet1.Cells _ (x, "d") + 0, sheet2.Range("prices"), 2, 0) Cells(x, "g") = Cells(x, "p") If Cells(x, "p") = Empty Then Cells(x, "g") = Cells(x, "o") Cells(x, "h") = Cells(x, "f") * Cells(x, "g") Cells(x, "c") = x - 17 End If code1.rar

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

السلام عليكم اخي محمد مرفق ملف يحتوي ما طلبت بحيث : يتم اعتماد الالوان الموجودة في المدى [a3:a57] واذا اردت اضافة اي لون تريده فقط قم بتلوين الخلية اللاحقة لاخر خلية يوجد فيها لون ويجب ان تكون الالوان متسلسلة اي بدون وجود خلايا بيضاء بينها حيث لا يقوم باعتماد اللون الابيض نهائيا

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

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

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

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

والله اخي عادل انك فنان وكلمة مبدع قليلة عليك عمل اكثر من رائع وتشكر عليه ولو سمحت لي بالمشاركة بملف لتلوين الخلية ---------------------------------------- استخدم الكود المسمى "test" Sub test() If Sheet1.Range("a1") > 55 Then Sheet1.Range("a1") = 0 Sheet1.Range("d5").Interior.ColorIndex = Sheet1.Range("a1").Value Sheet1.Range("a1").Value = Sheet1.Range("a1").Value + 1 Application.OnTime Now + TimeValue("00:00:02"), "test" End Sub ثم في حدث ال Workbook_Open استخدم الكود Private Sub Workbook_Open() Sheet1.Range("a1").Value = 0 test End Sub timeeeeeee.rar