كود تفعيل " Micro Enable " أوتماتيكياً

[مهند الزيدي]

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

[ياسر خليل أبو البراء]

أعتقد أنه لا توجد طريقة بالأكواد لأن الأكواد نفسها لن تنفيذ طالما أنه لم يتم ضبط إعدادات الماكرو لتمكن الماكرو من العمل

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

عموماً الأمر لن يتعدى بضعة كليكات بالماوس لتنفيذ المطلوب وتمكين الماكرو

تقبل تحياتي

[ياسر العربى]

اذا وقفت الاكواد يشتغل المرفق

 

data.rar

[وائل الاسيوطي]

ملف الريجستري الذي تحدث عنه اخي ياسر 

واستكمالا لكلام اخي ابو البراء هناك اكواد فقط تجبر المستخدم علي تفعيل الماكرو عند فتح الملف 

Enable Macros.rar

[مهند الزيدي]

شكر ا لك أخي العزيز "ياسر خليل " وأيضا لك أخي ياسر العربي 

مع تقديري الى الأخ وائل .. كيف يمكن إجبار المستخدم على تفعيل الماكرو

[وائل الاسيوطي]

علي المساء سأرفع لك الامثله 

[مهند الزيدي]

شكرا لك اخي وفقك الله لكل خير

[ياسر خليل أبو البراء]

أخي الكريم مهند الزيدي

إليك الكود التالي عله يفي بالغرض

Private Sub Workbook_Open()
'يوضع الكود في حدث المصنف ويقوم بإجبار المستخدم على تمكين الماكرو
'يعتمد الكود على ورقة عمل مخفية تقوم بوضع رسالة بها وتظهر في حالة
'عدم تمكين وحدات الماكرو وتختفي الورقة في حالة التمكين وتظهر أوراق المصنف
'وضع بها مربع نص عليه رسالة تنبيه للمستخدم [Prompt] قم بإنشاء ورقة باسم
'------------------------------------------------------------------------
    With Application
        .EnableCancelKey = xlDisabled
        .ScreenUpdating = False
            Call UnhideSheets
        .ScreenUpdating = True
        .EnableCancelKey = xlInterrupt
    End With

End Sub

Private Sub HideSheets()
    Dim Sheet As Object
    With Sheets("Prompt")
        If ThisWorkbook.Saved = True Then .[A100] = "Saved"
        .Visible = xlSheetVisible
        For Each Sheet In Sheets
            If Not Sheet.Name = "Prompt" Then
                Sheet.Visible = xlSheetVeryHidden
            End If
        Next

        If .[A100] = "Saved" Then
            .[A100].ClearContents
            ThisWorkbook.Save
        End If

        Set Sheet = Nothing
    End With
End Sub

Private Sub UnhideSheets()
    Dim Sheet As Object
    For Each Sheet In Sheets
        If Not Sheet.Name = "Prompt" Then
            Sheet.Visible = xlSheetVisible
        End If
    Next

    Sheets("Prompt").Visible = xlSheetVeryHidden

    Application.Goto Worksheets(1).[A1], True

    Set Sheet = Nothing
    ActiveWorkbook.Saved = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    With Application
        .EnableCancelKey = xlDisabled
        .ScreenUpdating = False
            Call HideSheets
        .ScreenUpdating = True
        .EnableCancelKey = xlInterrupt
    End With
End Sub

 

[مهند الزيدي]

شكرا لك أخي العزيز ياسر خليل ...وفقكم الله لكل خير...

 

[ياسر خليل أبو البراء]

جزيت خيراً أيها المهند على دعائك الطيب .. وفقنا الله وإياكم لما فيه الخير والمنفعة والصلاح