أبو حنف قام بنشر أغسطس 20, 2016 قام بنشر أغسطس 20, 2016 اخواني عندي مشكلة في الأكواد ولم أستطع التوصل لحل لها الفكرة أني دمجت بين كودين : ( كود تتبع التغييرات + كود تشغيل الشاشة الافتتاحية وتشغيل الملف تلقائيا حتى لو الماكرو في أعلى الأمان ) الكود يعمل معي جيدا ولكن عند فتح الملف أو غلقه يعطي رسالة خطأ ولكن يعمل الكود ويعطيني الخطأ على المتغير For i = 2 To Sheets.Count Option Explicit Dim vOldVal Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range) Dim bBold As Boolean If Target.Cells.Count > 1 Then Exit Sub If ActiveSheet.Name = "change" Then Exit Sub With Application .ScreenUpdating = False .EnableEvents = False End With If IsEmpty(vOldVal) Then vOldVal = "خلية فارغة" bBold = Target.HasFormula VBA.Calendar = vbCalHijri With Sheets("change") If .Range("A1") = vbNullString Then .Range("A1:H1") = Array("الخلية التي حصل فيها تعديل", "القيمة السابقه التي كانت في الخلية", "القيمة الجديدة", "حصل التعديل في الوقت", "حصل التعديل في التاريخ", "حصل التعديل من قبل المستخدم", "تاريخ التغيير", "يوزر") End If With .Cells(.Rows.Count, 1).End(xlUp)(2, 1) .Value = ActiveSheet.Name & " : " & Target.Address .Offset(0, 1) = vOldVal With .Offset(0, 2) If bBold = True Then .ClearComments .AddComment.Text Text:="maicl2010@gmail.com:" & Chr(10) & "" & Chr(10) & "تم إضافة معادلة في هذه الخلية" With Selection.Font .Name = "Traditional Arabic" .FontStyle = "غامق" .Size = 14 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = 3 .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With End If .Value = Target .Font.Bold = bBold End With .Offset(0, 3) = Time .Offset(0, 4) = Date .Offset(0, 5) = Application.UserName End With .Cells.Columns.AutoFit End With vOldVal = vbNullString With Application .ScreenUpdating = True .EnableEvents = True End With On Error GoTo 0 End Sub Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range) vOldVal = Target End Sub Private Sub test() Application.EnableEvents = True End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Sheets("sheet1").Activate Application.ScreenUpdating = False For i = 2 To Sheets.Count Sheets(i).Unprotect (123) Next Application.ScreenUpdating = True End Sub Private Sub Workbook_Open() Sheets("MyDate").Range("E3:IT3").ClearContents For i = 2 To Sheets.Count Sheets("MyDate").Cells(3, i + 3) = Sheets(i).Name Next End Sub
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.