اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

مشكلة في الأكواد الموجودة في حدث المصنف


الردود الموصى بها

اخواني عندي مشكلة في الأكواد ولم أستطع التوصل لحل لها 
الفكرة أني دمجت بين كودين : ( كود تتبع التغييرات + كود تشغيل الشاشة الافتتاحية وتشغيل الملف تلقائيا حتى لو الماكرو في أعلى الأمان )

الكود يعمل معي جيدا ولكن عند فتح الملف أو غلقه يعطي رسالة خطأ ولكن يعمل الكود ويعطيني الخطأ على المتغير

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

 

1.png

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information