منع حفظ المصنف بإسم آخر

منع حفظ المصنف بإسم آخر

يمكن استخدام الشفرة البرمجية  التالية لوقف أي مستخدم يقوم بحفظ المصنف بإسم آخر .

تنبيه هام

 الكود البرمجى التالي  سيسمح للمصنف بحفظه بموقع آخر داخل نفس الجهاز بإسم مختلف .


يجب وضع التعليمات البرمجية في الوحدة الخاصة من كائن المصنف ( ThisWorkbook ).

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


الخطوات كالتالي :-

1.   فتح محرر الأكواد من خلال الضغط على زرين ( ALT + F11 ) .
2.  الضغط دبل كليك على ( ThisWorkbook ) على يسار الشاشة .
3. نسخ ولصق الكود البرمجي التالي ومن ثم حفظ المصنف بتمكين وحدات الماكرو .

الكود البرمجي كالتالي :-

'Permits any person to use this code provided that the source is mentioned
'https://elshriefacademy.blogspot.com

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim NamePath As String
    Dim strName As String
    Dim lFind As Long

    If SaveAsUI = True Then
      Cancel = True
        With Application
                .EnableEvents = False
     NamePath = .GetSaveAsFilename
     strName = Mid(NamePath, InStrRev(NamePath, "\", -1, vbTextCompare) + 1, 256)

            If NamePath = "False" Then
                   .EnableEvents = True
                Exit Sub
            ElseIf strName <> Me.Name Then
                MsgBox "You cannot save as another name"
                    .EnableEvents = True
                Exit Sub
            Else
              Me.SaveAs NamePath
                 .EnableEvents = True
            End If
        End With
    End If
End Sub

وفيما يلي طريقة أخري لمنع المستخدم تماما من حفظ المصنف بأى اسم آخر أو بأى مكان آخر

وتكون فعاله فى حالة تمكين الماكرو بالطبع .

وخطوات التنفيذ ، مثل الخطوات السابقة تماما

الكود البرمجي كالتالي :- 

'Permits any person to use this code provided that the source is mentioned
'https://elshriefacademy.blogspot.com

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   If SaveAsUI = True Then Cancel = True
End Sub