bardisse

الملف المرفق الرقم السري youyouss youcef.xlsm

لسلام عليكم عملت كود جميل جدا كل ما يمضي يوم الا و التاريخ يتوقف فلا تستطيع الرجوع الى الوراء اريد ان تساعدوني في اللمسة الاخيرة فقط اريد اذا مضى اليوم الاول يكتب في c1 رقم 1 و اذا مضى اليوم الثاني يكتب في c2 رقم 2 الى غاية مضي اليوم الخامس يكتب في c5 رقم 5 اليكم الملف رجاءا ان تساعيدوني الكود الاول هذا الكود خاص بتجميد الوقت لكن يحتاج الى تعديل انا عاجز و شعري شاب من هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$C$1" Then Exit Sub [A1].Value = [A1] If [c1] = "" Then [A1].FormulaR1C1 = "=NOW()" If Target.Address <> "$C$2" Then Exit Sub [a2].Value = [a2] If [c2] = "" Then [a2].FormulaR1C1 = "=NOW()" If Target.Address <> "$C$3" Then Exit Sub [A3].Value = [A3] If [c3] = "" Then [A3].FormulaR1C1 = "=NOW()" If Target.Address <> "$C$4" Then Exit Sub [A4].Value = [A4] If [c4] = "" Then [A4].FormulaR1C1 = "=NOW()" If Target.Address <> "$C$5" Then Exit Sub [A5].Value = [A5] If [c5] = "" Then [A5].FormulaR1C1 = "=NOW()" End Sub الكود الثاني خاص بلصق الارقام في الخلية c1 ,c2 c3 c4 c5 لكن ينقل الخلية c1 فقط المشكل مازال قائم في عدم اللصق في الخلية c1,c2,c3,c4,c4 ارجو المساعدة Const Warning As String = "Warning" Private Sub Workbook_Open() If Cells(1, 1) > Cells(1, 2) Then Cells(1, 3) = 1 ElseIf Cells(2, 1) > Cells(2, 2) Then Cells(2, 3) = 1 ElseIf Cells(3, 1) > Cells(3, 2) Then Cells(3, 3) = 2 ElseIf Cells(4, 1) > Cells(4, 2) Then Cells(4, 3) = 3 ElseIf Cells(5, 1) > Cells(5, 2) Then Cells(5, 3) = 4 End If End Sub

اخواني الاعزاء لدي 30 جدول مرتبين بصورة عمودية في شيت (1) اريد كود لترحيلهم الى شيت (2) بصور افقية ارجوا المساعدة

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

Private Sub Workbook_Open() Dim date1 As Date Dim date2 As Date If date1 < DateValue("15/02/2020") Or Sheets("Warning").Range("S1") < 15 / 2 / 2020 Then If date2 > DateValue("20/02/2020") Or Sheets("Warning").Range("S2") > 25 / 2 / 2020 Then Sheets("Warning").Range("S1") = 15 / 2 / 2020 Sheets("Warning").Range("S2") = 25 / 2 / 2020 Application.Quit ThisWorkbook.Save End If MsgBox " expire ÇäÊåÊ ÕáÇÍíÉ ÇáãáÝ ,ãÓÊÔÇÑ ÇáÊÛÐíÉ ÇáãÏÑÓíÉ", vbYesNo, "" End If End Sub بحيث عند التنفيذ يغلق ملف الاكسال لكنه لا يفعل ارخو اعانتي في تصحيح هذا الكود من فضلك لا تكرر نفس المشاركة.. والا ستحذف جميع المشاركات

السلام عليكم اساتذتنا الكرام اريد كود لحماية شييت لفترة زمنية و ياريت يكون التاريخ محدد مثلا من 2020/02/15 الى غاية 2020/02/28 نكون مسموح العمل فيه اصغر < من 2020/02/15 غير مسموح اي لا يفتح اكبر > من 2020/02/28 غير مسموح اي لا يفتح و شكرا Private Sub Workbook_Open() If Date > DateValue("10/02/2020") Or Sheets("Warning").Range("S1") < 25 / 2 / 2020 Then Sheets("Warning").Range("S1") = youcef MsgBox " expire ÇäÊåÊ ÕáÇÍíÉ ÇáãáÝ ,ãÓÊÔÇÑ ÇáÊÛÐíÉ ÇáãÏÑÓíÉ", vbYesNo, "" ThisWorkbook.Password = "youyouss" ThisWorkbook.Save Application.Quit End If End Sub youcef.xlsm

اساتذتنا الكرام هذا الكود يجعل ملف الاكسيل يغلق حسب التاريخ المحدد لكن المشكلة عندما انقله الى جهاز اخر لا يشتغل لان macro غير مفعل كيف يشتغل هذا الكود و الماكرو غير مفعل لعلمكم اني عضو جديد و طرحة مشكلة و لم يجبني احد جزاكم الله خير Private Sub Workbook_Open() If Date > DateValue("08/02/2020") Or Sheets("feuil1").Range("S1") > Date Then Sheets("feuil1").Range("S1") = Date MsgBox " expire ÇäÊåÊ ÕáÇÍíÉ ÇáãáÝ ,ãÓÊÔÇÑ ÇáÊÛÐíÉ ÇáãÏÑÓíÉ", vbYesNo, "" ThisWorkbook.Password = "youyouss" ThisWorkbook.Save Application.Quit End If End Sub

رجو REMPLIR.rar البرمجة و الله انا في امس الحاجة الى هذا العمل لا تبخلوا علينا بالحلول اعانكم الله على الخير اخواني الاعزاء ذوي الخبرة في vba اريد كود لحماية خلية مثلا E2 في شيت 1 لـ 3 ملفات اكسال اي 03 workbook مع العلم ان هذه الملفات بها معلومات مختلفة حيث E2 تمثل اسم المؤسسة لذا اريد كود يحمي الخلية E2 ذات اللون الاصفر ل 3 ملف في ان واحد عضو جديد ارجو المساعدة جزاكم الله خيرا تجدون الملف المرفق هذه العملية اريد تطبيقها على 50 ملف اكسال في ان واحد ارجو المساعدة Sub ramzi5() Application.ScreenUpdating = False Application.Calculation = xlManual Application.EnableEvents = False Workbooks("SENDRAS.xlsm").Activate Workbooks("SENDRAS.xlsm").Sheets(1).Range("b1:b" & Cells(Rows.Count, "a").End(xlUp).Row).Copy Workbooks("01-ÇáäÇÙÑíÉ.xlsm").Activate x = Range("a" & Rows.Count).End(xlUp).Row Workbooks("01-ÇáäÇÙÑíÉ.xlsm").Sheets(1).Range("e2").Select Selection.PasteSpecial xlPasteValues Workbooks("SENDRAS.xlsm").Activate [a1].Select Application.CutCopyMode = False Workbooks("SENDRAS.xlsm").Activate Workbooks("SENDRAS.xlsm").Sheets(1).Range("c1:c" & Cells(Rows.Count, "a").End(xlUp).Row).Copy Workbooks("02-ÇáÚÈÇÓíÉ.xlsm").Activate x = Range("a" & Rows.Count).End(xlUp).Row Workbooks("02-ÇáÚÈÇÓíÉ.xlsm").Sheets(1).Range("e2").Select Selection.PasteSpecial xlPasteValues Workbooks("SENDRAS.xlsm").Activate [a1].Select Application.CutCopyMode = False Workbooks("SENDRAS.xlsm").Activate Workbooks("SENDRAS.xlsm").Sheets(1).Range("d1:d" & Cells(Rows.Count, "a").End(xlUp).Row).Copy Workbooks("03-ÇáãäÕæÑíÉ.xlsm").Activate x = Range("a" & Rows.Count).End(xlUp).Row Workbooks("03-ÇáãäÕæÑíÉ.xlsm").Sheets(1).Range("e2").Select Selection.PasteSpecial xlPasteValues Workbooks("SENDRAS.xlsm").Activate [a1].Select Application.CutCopyMode = False Application.Calculation = xlAutomatic Application.EnableEvents = True Application.ScreenUpdating = True End Sub من فضلك لا تكرر نفس المشاركان والا ستحذف جميع المشاركات .... يكفيك كتابة للرفع على نفس المشاركة وممنوع كثرة الإلحاح

اخواني الاعزاء ذوي الخبرة في vba اريد كود لحماية خلية مثلا E2 في شيت 1 لـ 3 ملفات اكسال اي 03 workbook مع العلم ان هذه الملفات بها معلومات مختلفة حيث E2 تمثل اسم المؤسسة لذا اريد كود يحمي الخلية E2 ذات اللون الاصفر ل 3 ملف في ان واحد عضو جديد ارجو المساعدة جزاكم الله خيرا تجدون الملف المرفق هذه العملية اريد تطبيقها على 50 ملف اكسال في ان واحد ارجو المساعدة REMPLIR.rar