الجموعي

تحويل المعادلات الى كود تفضل الكود Sub Formula() Range("K3").Formula = "=IF(M3<=1,"""",IF(M3>=1,B3))" Range("K4").Formula = "=IF(M4<=1,"""",IF(M4>=1,C3))" Range("K5").Formula = "=IF(M5<=1,"""",IF(M5>=1,D3))" Range("K6").Formula = "=IF(M6<=1,"""",IF(M6>=1,E3))" Range("K7").Formula = "=IF(M7<=1,"""",IF(M7>=1,B9))" Range("K8").Formula = "=IF(M8<=1,"""",IF(M8>=1,C9))" Range("K9").Formula = "=IF(M9<=1,"""",IF(M9>=1,D9))" Range("K10").Formula = "=IF(M10<=1,"""",IF(M10>=1,E9))" Range("K11").Formula = "=IF(M11<=1,"""",IF(M11>=1,B15))" Range("K12").Formula = "=IF(M12<=1,"""",IF(M12>=1,C15))" Range("K13").Formula = "=IF(M13<=1,"""",IF(M13>=1,D15))" Range("K14").Formula = "=IF(M14<=1,"""",IF(M14>=1,E15))" End Sub

للرفع

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

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

اخي الكريم قم بوضع هذه المعادلة في في اي خلية شئت واكتب القيمة في الخلية A1 =COS( RADIANS( A1 ) ) أو =COS(A1*PI()/180) مثلا لو قية الخلية A1 تساوي 60 فإن قيمة الخلية المدرجه بها المعادلة ستكون 0.5

انا عندي الملف تمام اي نسخة اوفيس تستخدم

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

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

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

تفضل أخي هذا الكود عسى يفيدك هو غلق الفورم بعد 10 ثواني وبإمكانك التحكم في التوقيت ActiveWorkbook.close.rar

بعد إذن الأستاذ ابو تراب تم إضافة زر الحذف للفورم + إستدعاء بيانات الليست بوكس عن طريق الكود أما بالنسبة لطريقة إستدعاء البيانات عن طريق MyRange كما في مرفق مشاركة الأستاذ أبو تراب يكفي إضافة زر إعادة تسميته بهذا الإسم cmdDelete ووضع الكود التالي فيه Private Sub cmdDelete_Click() Dim I As Long With Me.listMain For I = .ListCount - 1 To 0 Step -1 If .Selected(I) Then Sheets("all").Rows(I + 1).EntireRow.Delete Next I End With End Sub تعديل +حذف.zip

تفضل أخي مشكل13.rar

ارفق الملف اخي

تفضل أخي تم عمل المطلوب بواسطة الإرتباط التشعبي التنقل بين الصفحات_3.rar

تـفضل اخي المعادلة التالية شرح المعادلة لو كانت قيمة الخلية A3 أكبر من الرقم 200 أترك الخلية فارغة لو كانت قيمة الخلية A3 أصغر او تساوي من الرقم 100 اكتب 30 لو كانت قيمة الخلية A3 أصغر او تساوي من الرقم 200 اكتب 40 =IF(A3>200;"";IF(A3<=100;"30";IF(A3<=200;"40")))

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

أستاذي القدير / ياسر ابو خليل ما رايك في هذه الفكرة هل تصلح أم لا هذه الفكرة في ترحيل البيانات يرحل الصف 3 إلى جميع الشيتات اريد تعديل منك على الكود بحيث كل صفحة بعد الأخرى ترحل لها الصفوف بالترتيب مثلا الصفحة 2 يرحل لها بيانات الصف 3 والصفحة 3 يرحل لها بيانات الصف 4 Sub Macro1() Dim sh As Worksheet Dim ws As Worksheet Set sh = Sheets("SHET") Dim i As Integer On Error Resume Next For i = 2 To Sheets.Count Set ws = Sheets(i) ws.Range("A12").Value = sh.Range("A3").Value ws.Range("B12").Value = sh.Range("B3").Value ws.Range("C12").Value = sh.Range("C3").Value ws.Range("D12").Value = sh.Range("D3").Value Next i End Sub

تفضل أخي ComBoboxDateList.rar

السلام عليكم قم بإنشاء زر واربطه بالمكرو التالي هذا نموذج عميل 1 Sub Macro1() Dim sh As Worksheet Dim ws As Worksheet Set sh = Sheets("SHET") Set ws = Sheets("shet1") ws.Range("A12").Value = sh.Range("A3").Value ws.Range("B12").Value = sh.Range("B3").Value ws.Range("C12").Value = sh.Range("C3").Value ws.Range("D12").Value = sh.Range("D3").Value End Sub ومع باقي الشيتات عدل ما يجب تعديله

تم التعديل وإضافة كود المجموعة E.F جرب المرفق تعديل كود2222.rar

تفضل أخي محاولة مني لعله المطلوب تعديل كود1.rar

إضافة أخرى تشبه طريقه الأستاذ / ياسر خليل لكن بكود مغاير الملف_3.rar

بعد إذن الاستاذ القدير/ ياسر خليل والأخ altag إثراء للموضوع تفضل المرفق التالي الملف_3.rar

أرفق الملف ليساعدك الأساتذه الفضلاء

تكمله بخصوص التعامل مع الألوان بواسطة الأكواد أقدم لكم كود كود تلوين تبويبات الأوراق بضغطه زر واحدة Sub Change_Sheet_Tab_ِColor() 'خاص بفهرس الألوان[Color] إعلان متغير Dim Color As Integer 'خاص بأوراق العمل[WS] إعلان متغير Dim WS As Worksheet 'القيمة 0= [Color] حيث المتغير Color = 0 'عند وجود اخطاءإنتقل التالي On Error Resume Next ' الحلقة التكرارية للبحث في أوراق العمل For Each WS In Worksheets '[Color]فهرس الألوان إبتداء من قيمة المتغير = [WS] لون تبويب أوراق العمل WS.Tab.ColorIndex = Color '1 +[Color]القيمة = [Color] حيث المتغير Color = Color + 1 ' التالي Next End Sub الملف المرفق Change_Sheet_Tab_ِColor.rar