زياد عبد الجليل

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

شكرا جزيلا استاذمحمد بارك الله فيك

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

رجاء من الاخوة التمس منكم رابط تحميل هذا البرنامج ان امكن

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

عرض محتوى خلية في تاكس بوكس .rar

استاذ بن علية بارك الله فيك نعم هذا هو المطلوب بالضبط وشكرا على هذا التميز

السلام على جميع الاخوة الافاضل اما بعد :

لدي طلبين

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

واذا كان ناتج خانة الاشهر = 12 معناه سنة يتم اضافتها الى خانة السنوات

الطلب الثاني :

اريد اضافة مدة سنتين و نصف اي 2 و 6 اشهر الى تاريخ ليصبح الناتج تاريخ مثلا 15/02/2016 لدينا هنا 15 في خانة اليوم اي 0 و لا نحتسب الايام ونبدا الحساب من فيفري مدة سنتين و نصف لصبح التاريخ في النهاية مثلا01/08/2018

اما اذا كان التاريخ مثلا 17/02/2016 هنا في الايام لدينا خانة الايام اكبر من 15 هنا لا نحتسب الايام و نضيف شهر لخانة الاشهر ليصبح التاريخ في النهاية01/09/2018

لمذيد من التوضيح الرجو الاطلاع على الملف المرفق

طلب مساعدة في احتساب الفرق بين تاريخين.rar

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

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

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

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

اليك البرنامج التالي اخي و ابحث بالمنتدى ستجد المطلوب

XLtoEXE.zip

شكرا استاذ بن علية هذا ما اطلبه بالضبط بارك الله فيك استاذ

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

2- اذاكانت مثلا نفس الخلية تساوي الصفر يتم ادراج كلمة لا شئ في خانة اخرى محددة و اذا كان يساوي 1 فما فوق فهنا يتم جمع خلية مع خلية و ادراج الناتج في نفس الخلية المحددة سالفا

لفهم المطلوب استاذي الفاضل اليك الملف المرفق

طلب تحويل مدة الى عدد و احتساب الفرق.rar

السلام على جميع الاساتذة الافاضل:
لدي طلب نوعا ما معقد و المتمثل في طلب معادلة في حالة اذا كان قيمة خليتين = 3 سنوات و 6 اشهر و 00 يوم(لا يهم الايام هنا)  هنا مباشرة يتم وضع قيمة 1 في خلية محددة فمثلا اذا كانت قيمة خلية تساوي 5 سنوات و 6 اشهر و 15 يوم هنا المحتوى يتضمن 3 سنوات و 6 اشهر و 00 يوم هنا يتم وضع قيمة 1 في خلية محددة و اذا كانت تساوي مثلا 6 سنوات و 12 شهر معناه المجموع هنا 07 سنوات و هنا المحتوى يتضمن مرتين 
3 سنة و 6 اشهر هنا يتم وضع عدد 2
و بعدها يتم احتساب الفرق اي مثلا 5 سنوات و 6 اشهر و 15 يوم اي نطرح منه 3 سنوات و 6 اشهر و 00 يوم ليصبح الناتج 02 سنة و 0 شهر و 15 يوم
بالاضافة الى طلب اخر تجدونه في المرفق التالي و لكم مني جزيل الشكر.

طلب تحويل مدة الى عدد و احتساب الفرق.rar

السلام عليكم استاذ ربيع و السلام على جميع الاخوة الافاضل

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

Private Sub ComboBox2_Change()
Dim Ws As Worksheet
Dim sName As String: sName = Me.ComboBox2.Value
Set Ws = ThisWorkbook.Sheets(sName)
Dim iRow As Long: iRow = Ws.Cells(Rows.Count, 1).End(xlUp).Row + 0
If Not ComboBox2.Text = "" Then
 Sheets(ComboBox2.Text).Select
end if
end sub
,وهذا في يوزر فورم انيسياليز

Private Sub UserForm_Initialize()
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Sheets
Me.ComboBox2.AddItem Ws.Name
End If
Next

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

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

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

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

منذ ساعه, علي فاهم said:

ليست فعاله بكل المعايير .. انت نزلت كود فقط ولم تنزل مرفق

انا حبيت اجرب كودك اللي انت كاتب فيه يوضع في

'يوضع هذا الكود في this workbook

ولم يعمل جيدا اصبح يختفي الملف بعد وضع الرقم السري

فاجاب الاستاذ ياسر بان الكود يوضع في موديول

ويوضع ايضا فورم نفذت ولم يعمل جيدا ذكر انه لابد من

من و ضع سطر لإظهار التطبيق في زر الأمر الذي ستقوم برسمه على الفورم

فلم افهم هذه الجمله السهله جدا بالنسبه له ولك

وبرده نفذت ماقال وبرضه اختفى الملف بعد وصع الرقم السري

........... اللهم امدنا الفهم لكي نفهم الاخرين

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

الاستاذ ياسر اخي علي لديه طريقة وهي ان لا يعطيك كل شئ جاهز ولكن يعطيك 99%من الحل و الباقي هو ان تتعلم بنفسك قراءة الاكواد و كيفية ادراجها و هذه طريق اعتقد انها فعالة للمبتدئين امثالنا ...اليك ملف مرفق فيه الكود

'اذا كان لديك يوزرفورم تظهر بمجرد فتح الملف اضف  التالي
MsgBox "Correct"
userform1.show

mot de passe.rar

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

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

            If Target = "" Then Target.Offset(, -1).ClearContents: Target.Offset(, 1).Resize(, 10).ClearContents: GoTo Skipper'هنا عدد الاعمدة الاضافية
            For Each ws In ThisWorkbook.Worksheets(Array("وحدة النشاط", "وحدة الانتاج", "وحدة النقل", "وحدة التوزيع"......'هنا اسماء الصفحات))

هل يمكن استاذ ياسر تعديل بسيط مثلا عوض ادراج اسماء الصفحات وضع كود مثلا من الصفحة 1 الى الصفحة 10

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

    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Row > 10 And Target.Column = 2 Then
        Application.EnableEvents = False
            If Target = "" Then Target.Offset(, -1).ClearContents: Target.Offset(, 1).Resize(, 20).ClearContents: GoTo Skipper
            For Each ws In ThisWorkbook.Worksheets(Array("وحدة الانتاج", "وحدة النقل", "وحدة التوزيع",.....هنا اسماء الصفحات))
                xf = Application.Match(Target, ws.Columns(2), 0)
                If IsNumeric(xf) Then
                    Target.Offset(, -1) = Target.Row - 10
                    Target.Offset(, ws.Index * 2 - 1) = ws.Cells(xf, 10)
                    Target.Offset(, ws.Index * 2) = ws.Cells(xf, 11)
                End If
            Next ws
Skipper:
        Application.EnableEvents = True
    End If
End Sub

48 دقائق مضت, ياسر خليل أبو البراء said:

وعليكم السلام أخي الكريم زياد

جرب الكود التالي في حدث ورقة العمل المراد التجميع فيها

قم بكتابة القسم في العمود الثاني ..

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws      As Worksheet
    Dim xf      As Variant
    
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Row > 3 And Target.Column = 2 Then
        Application.EnableEvents = False
            If Target = "" Then Target.Offset(, -1).ClearContents: Target.Offset(, 1).Resize(, 6).ClearContents: GoTo Skipper
            For Each ws In ThisWorkbook.Worksheets(Array("وحدة الانتاج", "وحدة النقل", "وحدة التوزيع"))
                xf = Application.Match(Target, ws.Columns(2), 0)
                If IsNumeric(xf) Then
                    Target.Offset(, -1) = Target.Row - 3
                    Target.Offset(, ws.Index * 2 - 1) = ws.Cells(xf, 3)
                    Target.Offset(, ws.Index * 2) = ws.Cells(xf, 4)
                End If
            Next ws
Skipper:
        Application.EnableEvents = True
    End If
End Sub

 

بارك الله فيك استاذ ياسر كود ولا في الاحلام.

بارك الله فيك استاذ ياسر على مرورك الطيب وملاحظتك التي اعتز بها شكرا لك

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

السلام على جميع الاخوة الافاضل اما بعد :

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

بدون اطالة اليكم اخوتي الكود التالي ربما يفيد بعض المبتدئين امثالي ولكم مني خالص عبارات الشكر.

'يوضع هذا الكود في this workbook
Sub Auto_Open()
Application.Visible = False
Dim UserName As String
UserName = InputBox("Please Enter Your USER NAME.")
If UserName = "123456" Then ' اكتب هناالرقم السري للدخول
MsgBox "Correct"
UserForm1.Show 'هنا اذا كان لديك يوزر فورم اما اذا لم يكن لديك فورم يمكن مسح هذا السطر 
Exit Sub
Else
MsgBox "Incorrect"
End If
   ActiveWorkbook.Save
 Application.Quit
End Sub