كود تفعيل الماكرو ع الجهاز

[محمد عبد الناصر]

السلام عليكم ورحمة الله وبركاته ؛؛

كنت محتاج كود تفعيل الماكرو على الجهاز اوتوماتيك بحيث اى ملف افتحه بعد كده يكون الماكرو مفعل ميطلبش منى enable content

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

وعليكم السلام ورحمة الله وبركاته ؛؛

أخي الكريم محمد عبد الناصر لا يوجد كود سيقوم بتفعيل الماكرو بشكل تلقائي لأن الماكرو لو معطل كيف سيعمل الكود حتى وإن وجد ؟؟!!

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

 

Registry.rar

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

لا يوجد تفعيل ماكرو اوتوماتيك

اما يدوي او عن طريق ملفات الريجستري المرفقة واما اجبار التشغيل عن طريق ملف تنفيذي اخر يقوم بفتح الملف

او تحويله لتنفيذي

 

Enable Macros.rar

[محمد عبد الناصر]

18 دقائق مضت, ياسر خليل أبو البراء said:

وعليكم السلام ورحمة الله وبركاته ؛؛

أخي الكريم محمد عبد الناصر لا يوجد كود سيقوم بتفعيل الماكرو بشكل تلقائي لأن الماكرو لو معطل كيف سيعمل الكود حتى وإن وجد ؟؟!!

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

 

Registry.rar

الماكرو بيكون مفعل لاول مره

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

17 دقائق مضت, ياسر العربى said:

لا يوجد تفعيل ماكرو اوتوماتيك

اما يدوي او عن طريق ملفات الريجستري المرفقة واما اجبار التشغيل عن طريق ملف تنفيذي اخر يقوم بفتح الملف

او تحويله لتنفيذي

 

Enable Macros.rar

الماكرو بيكون مفعل لاول مره

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

تم تعديل مايو 23, 2016 بواسطه محمد عبد الناصر

[عبدالسلام ابوالعوافي]

يمكن اضافة الموقع او المجلد الي المواقع الموثوقة .. ولن يطلب منك تمكين المحتوى

[محمد عبد الناصر]

طيب مفيش طريقه اخلى الى شغال على البرنامج غصب عنه يفعل الماكرو لو اخده كوبى ؟؟؟؟؟؟؟؟

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

إنت قلت على الطريقة إنك تخفي الشيتات في حالة عدم تمكين الماكرو !! فهل تريد الطريقة ام أن لديك علم بها؟

[محمد عبد الناصر]

18 دقائق مضت, ياسر خليل أبو البراء said:

إنت قلت على الطريقة إنك تخفي الشيتات في حالة عدم تمكين الماكرو !! فهل تريد الطريقة ام أن لديك علم بها؟

والله وصلت لكود كده جميل اوى اوى ونفعت معايا الحمد لله عن طريق ان بحوط كود فـــ Thisworkbook
 

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 bIsClosing = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Cancel = True Or bIsClosing = False Then Exit Sub
Run "HideAll"
End Sub



Private Sub Workbook_Deactivate()
If bIsClosing = False Then Exit Sub
Run "HideAll"
End Sub

Private Sub Workbook_Open()
Run "ShowAll"
End Sub

وبعمل موديول جديد بحوط فيه الكود ده
 

Public bIsClosing As Boolean
Dim wsSheet As Worksheet

Sub HideAll()

Application.ScreenUpdating = False
For Each wsSheet In ThisWorkbook.Worksheets
    If wsSheet.CodeName = "Sheet1" Then
     wsSheet.Visible = xlSheetVisible
    Else
     wsSheet.Visible = xlSheetVeryHidden
    End If
Next wsSheet
Application.ScreenUpdating = True

End Sub

Sub ShowAll()
bIsClosing = False

For Each wsSheet In ThisWorkbook.Worksheets
    If wsSheet.CodeName <> "Sheet1" Then
     wsSheet.Visible = xlSheetVisible
    End If
Next wsSheet

Sheet1.Visible = xlSheetVeryHidden
End Sub

واقفل الملف وبسيف من غير ما افعل ماكرو ولا اى حاجه اهم حاجه انى اعمل سيف enable macro وهو كده بيخفى كل الشيتات ما عدا الشيت الى اسمو فى الاصل Sheet1
ولو حد اخد الملف كوبى الملفات بتختفى ولما يفعل الماكرو بتظهر جربه كده حضرتك لو نفع ممكن انا او حضرتك تعمل بيه موضوع عشان الكل يستفيد ان لازم الى قاعد شغال على الملف يفعل الماكرو

تم تعديل مايو 23, 2016 بواسطه محمد عبد الناصر

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

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

إن شاء الله ممكن أعمل بيه موضوع مستقل ليكون مرجع للأخوة الأعضاء

والحمد لله أن تم المطلوب على خير

تقبل تحياتي

[محمد عبد الناصر]

2 دقائق مضت, ياسر خليل أبو البراء said:

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

إن شاء الله ممكن أعمل بيه موضوع مستقل ليكون مرجع للأخوة الأعضاء

والحمد لله أن تم المطلوب على خير

تقبل تحياتي

حضرتك اخر حاجه بس عايز اضيف كود قفل الطباعه ده
 

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If PrvntPrnt = 0 Then Cancel = True
End Sub

Private Sub Workbook_Open()
PrvntPrnt = 0
End Sub

على الكود ده مش عارف اعملها

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 bIsClosing = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Cancel = True Or bIsClosing = False Then Exit Sub
Run "HideAll"
End Sub



Private Sub Workbook_Deactivate()
If bIsClosing = False Then Exit Sub
Run "HideAll"
End Sub

Private Sub Workbook_Open()
Run "ShowAll"
End Sub

 

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

يكفي أن تقوم بالتعديل التالي

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
End Sub

يوضع في حدث المصنف

[محمد عبد الناصر]

4 دقائق مضت, ياسر خليل أبو البراء said:

يكفي أن تقوم بالتعديل التالي

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
End Sub

يوضع في حدث المصنف

لو ينفع حضرتك تعملى الكود كامل لأنى حاولت مش عارف اعمل ايه انا ضعيف شويه فى برمجة الاكسيل انا اسف لحضرتك

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

ضع الكود مع الأكواد الأخرى الموجودة في حدث المصنف .. في أي مكان ..!!

روح لمحرر الأكواد Alt + F11 وانقر دبل كليك على ThisWorkbook ثم ضع أكوادك في هذا الموديول ..

[محمد عبد الناصر]

3 دقائق مضت, ياسر خليل أبو البراء said:

ضع الكود مع الأكواد الأخرى الموجودة في حدث المصنف .. في أي مكان ..!!

روح لمحرر الأكواد Alt + F11 وانقر دبل كليك على ThisWorkbook ثم ضع أكوادك في هذا الموديول ..

منا بعمل كده عايز احوط كود قفل الطباعه وكود اخفاء الشيتات واظهارها مع بعض بيجبلى ايرور بحوط الكود كده بالظبط

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If PrvntPrnt = 0 Then Cancel = True
End Sub

Private Sub Workbook_Open()
PrvntPrnt = 0
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Cancel = True Or bIsClosing = False Then Exit Sub
Run "HideAll"
End Sub

Private Sub Workbook_Deactivate()
If bIsClosing = False Then Exit Sub
Run "HideAll"
End Sub

Private Sub Workbook_Open()
Run "ShowAll"
End Sub

بيجبلى ايرورر عشان انا عامل حاجه غلط فى الكود مش عارف ايه هيا

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

أخي الكريم محمد

جرب الموضوع التالي وضع الأكواد كما شرحتها بالرابط وأضف إليها الكود الذي وضعته في آخر مشاركة لي في هذا الموضوع الخاص بك

الرابط من هنا

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

تفضلوا حل مشكلة تفعيل الماكرو على اي جهاز اخر بدون اللجوء الى تفعيل الماكرو نهائيا

شغل برنامجك بدون تفعيل الماكرو

تقبلو تحياتي

[محمد عبد الناصر]

منذ ساعه, ياسر خليل أبو البراء said:

أخي الكريم محمد

جرب الموضوع التالي وضع الأكواد كما شرحتها بالرابط وأضف إليها الكود الذي وضعته في آخر مشاركة لي في هذا الموضوع الخاص بك

الرابط من هنا

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

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

الخطأ بيظهر فين بالضبط

 

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

[محمد عبد الناصر]

3 ساعات مضت, ياسر خليل أبو البراء said:

الخطأ بيظهر فين بالضبط

 

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

لما بكتب بحوط الكودين مع بعض بيجبلي خطأ لما بقفل البرنامج او افتح البرنامج لو ينفع بالله عليك تحوطلي انت الكود فى ملف وترفعهولى يبق كتر الف خيرك انا مش واقف غير على الكود ده ربنا يعزك

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

أخي الكريم لابد من تعلم الأساسيات في التعامل مع محرر الأكواد .. لا أعرف ما المشكلة لديك

عموماً جرب الملف المرفق

Force Users To Enable Macros In Workbook YasserKhalil.rar

[محمد عبد الناصر]

18 دقائق مضت, ياسر خليل أبو البراء said:

أخي الكريم لابد من تعلم الأساسيات في التعامل مع محرر الأكواد .. لا أعرف ما المشكلة لديك

عموماً جرب الملف المرفق

Force Users To Enable Macros In Workbook YasserKhalil.rar

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

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If PrvntPrnt = 0 Then Cancel = True
End Sub

Private Sub Workbook_Open()
PrvntPrnt = 0
End Sub

xD.rar

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

أخي الكريم محمد عبد الناصر

بعد الإطلاع على ملفك جرب التعديل التالي

 

أولاً الموديول رقم 1 قم بوضع الكود التالي بدلاً من الكود الموجود حيث تمت إضافة بعض الأسطر

Public PrvntPrnt

Sub Print_Specific_Pages_In_ActiveSheet()
    Dim Arr, SH As Worksheet, Rng As Range, Cell As Range, I As Long
    Set SH = ActiveSheet

    PrvntPrnt = 1

    With SH
        ReDim Arr(0 To .HPageBreaks.Count + 1)

        If Len(.PageSetup.PrintTitleRows) Then
            Set Rng = .Range(.PageSetup.PrintTitleRows)
            Arr(0) = Rng.Rows(Rng.Row + Rng.Rows.Count).Row
        Else
            Arr(0) = 1
        End If

        For I = 1 To .HPageBreaks.Count
            Arr(I) = .HPageBreaks(I).Location.Row
        Next I

        Arr(UBound(Arr)) = .Cells.SpecialCells(xlCellTypeLastCell).Row + 1

        For I = UBound(Arr) To (LBound(Arr) + 1) Step -1
            Set Rng = Intersect(.Rows(Arr(I - 1) & ":" & (Arr(I) - 1)), .UsedRange, .Columns("G"))
            If Not Rng Is Nothing Then
                For Each Cell In Rng
                    If Cell.Value > 0 Then
                        On Error GoTo Skipper
                        .PrintOut From:=I, To:=I
                        Exit For
                    End If
                Next Cell
            End If
        Next I
    End With
    
Skipper:
    PrvntPrnt = 0
End Sub

ثانياً قم بوضع الكود التالي في حدث المصنف ThisWorkbook

Const Warning As String = "Warning"

Private Sub Workbook_Open()
    Dim Ws As Worksheet
    
    PrvntPrnt = 0
    
    Application.ScreenUpdating = False
        For Each Ws In ThisWorkbook.Worksheets
            Ws.Visible = xlSheetVisible
        Next Ws
    
        Sheets(Warning).Visible = xlVeryHidden
    Application.ScreenUpdating = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Ws As Worksheet

    Application.ScreenUpdating = False
        Sheets(Warning).Visible = xlSheetVisible
    
        For Each Ws In ThisWorkbook.Worksheets
            If Ws.Name <> Warning Then
                Ws.Visible = xlVeryHidden
            End If
        Next Ws
    Application.ScreenUpdating = True

    ActiveWorkbook.Save
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    If PrvntPrnt = 0 Then Cancel = True: MsgBox "PRINT Disabled", vbCritical
End Sub

ولا تنسى أن تقوم بتعيين الماكرو في زر الأمر الموجود في ورقة العمل Sheet1 ..كليك يمين على زر الأمر ثم Assign Macro واختر الإجراء الفرعي المسمى Print_Specific_Pages_In_Activesheet

لابد أن تقوم بتنفيذ الخطوات بنفسك لتتعلم وترتقي والموضوع ليس بمستحيل ولا بصعب .. يمكنك الرجوع إلى موضوع "بداية الطريق لانقاذ الغريق" لتعرف التعامل مع البدايات والأساسيات للتعامل مع محرر الأكواد

رابط الموضوع من هنا

[محمد عبد الناصر]

ياااااااااااااااااا ساااااااااااااااااااااااتر اخيرااااااااا والله مش عارف اقول لحضرتك ايه غير ان ربنا يجعله فى ميزان حسناتك كان فى بعض المشاكل حضرتك غيرتهالى فى الكود بس الحمد لله بفهم شويه فموضوع الاكواد ده وعملتها بس اهم مشكله حضرتك حلتهالى شكرااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااا

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

2 ساعات مضت, محمد عبد الناصر said:

ياااااااااااااااااا ساااااااااااااااااااااااتر اخيرااااااااا والله مش عارف اقول لحضرتك ايه غير ان ربنا يجعله فى ميزان حسناتك كان فى بعض المشاكل حضرتك غيرتهالى فى الكود بس الحمد لله بفهم شويه فموضوع الاكواد ده وعملتها بس اهم مشكله حضرتك حلتهالى شكرااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااا

نعتذر إننا طولنا الموضوع عليك .. بس دا بيكون سببه التشتت في الطلب ، لأني أصلاً اشتغلت على الملف من غير ما أرجع لك في المرات الأخيرة ، بمعنى إنت طلبت إلغاء الطباعة وأنا عملت عليها بعد الإشارة فقط إلى أنك تستخدم كود مخصص لإلغاء الطباعة ، والكود كان ينقصه بعض الأسطر ليتم ضبطها

عموماً الحمد لله أن تم المطلوب على خير ، والحمد لله الذي بنعمته تتم الصالحات

تقبل تحياتي