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

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


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

الاخت الكريمة 

راجعى الرابط التالى 

http://www.officena.net/ib/index.php?showtopic=40743&hl=%2B%D9%85%D9%86%D8%B9+%2B%D8%A7%D9%84%D9%86%D8%B3%D8%AE

المشاركة رقم 4

كود للرائع عبدالله المجرب

تقبلى تحياتى

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

عذرا اخي الفاضل هل اقوم بعمل الخطوات التي سبقت ان تفضلت بشرحها لي هنا ( ادراج مديول )

 

http://www.officena.net/ib/index.php?s=974b493a8f234f1d52fd9d66f9189ad7&showtopic=58010

تم تعديل بواسطه Ms. Ghada
رابط هذا التعليق
شارك

الاخت الكريمة

نصيحه مهمه جدا جدا

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

ثانيا الخطوات

 

 

1- اول شئ هنعملى ادراج مودويل جديد وتنسخى الكود ده فيه

Option Explicit

Sub ToggleCutCopyAndPaste(Allow As Boolean)
'Activate/deactivate cut, copy, paste and pastespecial menu items
    Call EnableMenuItem(21, Allow)    ' cut
    Call EnableMenuItem(19, Allow)    ' copy
    Call EnableMenuItem(22, Allow)    ' paste
    Call EnableMenuItem(755, Allow)   ' pastespecial

'Activate/deactivate drag and drop ability
    Application.CellDragAndDrop = Allow

'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
    With Application
        Select Case Allow
            Case Is = False
                .OnKey "^c", "CutCopyPasteDisabled"
                .OnKey "^v", "CutCopyPasteDisabled"
                .OnKey "^x", "CutCopyPasteDisabled"
                .OnKey "+{DEL}", "CutCopyPasteDisabled"
                .OnKey "^{INSERT}", "CutCopyPasteDisabled"
            Case Is = True
                .OnKey "^c"
                .OnKey "^v"
                .OnKey "^x"
                .OnKey "+{DEL}"
                .OnKey "^{INSERT}"
            End Select
    End With
End Sub

Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
     'Activate/Deactivate specific menu item
    Dim cBar As CommandBar
    Dim cBarCtrl As CommandBarControl
    For Each cBar In Application.CommandBars
        If cBar.Name <> "Clipboard" Then
            Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
            If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
        End If
    Next
End Sub
 
Sub CutCopyPasteDisabled()
'Inform user that the functions have been disabled
    MsgBox "Sorry!  Cutting, copying and pasting have been disabled in this workbook!"
End Sub

ثانيا هتنسخى الكود التالى وتلصقية فى  حدث ThisWorkbook 

حدث ThisWorkbook  اتبعى تعليمات الصورة

D3lt3B.png

Option Explicit

Private Sub Workbook_Activate()
    Call ToggleCutCopyAndPaste(False)
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Deactivate()
    Call ToggleCutCopyAndPaste(True)
End Sub

Private Sub Workbook_Open()
    Call ToggleCutCopyAndPaste(False)
End Sub

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

واهم شئ تعملى على نسخه من الملف وليس الملف الاصلى الين التاكد من ان الكود تمام زى ما انتى عايزة 

جربى وعلمينى بالنتيجة

تقبل تحياتى

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

انتى حطيت الكود الاول فى مودويل جديد

والكود الثانى فى حدث الملف ThisWorkbook ( اعملى دبل كليك على ThisWorkbook هيفتح معك شاشة بيضه انسخى الكود الثانى فيها)

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

لما تعملى ALT +f11

هيفتح معك محرر الاكواد شوفى الصورة دى

D3lt3B.png

 

لما تعملى دبل كليك على ThisWorkbook هيفتح معك شاشة بيضه انسخى الكود الثانى فيها 

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

اخي الكريم انا عملت الخطوات دي بالظبط :

1= فتحت ملفي وضغطت Alt+F11

2- من قائمة Insert اختارت Moduel ظهرت شاشة بيضاء لصق عليها الكود الاول

3- ضغط دبل كليك على This workbook فظهرت شاشة بيضاء اخرى لصق عليها الكود الثاني

4- ثم اغلقت الملف و فتحته مرة اخرى و حاولت النسخ و الحذف وجدت الامرين قد تم تنفيذهما

 

فهل ما قمت بتنفيذه خطأ

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

السلام عليكم

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

 

بعد وضع الأكواد يجب الحفظ  باسم معين و  بصيغة معينة  ( نختار  من نوع الـ     save as type  الخيار enabled macro )

  

أعتقد ان هذا قد يكون سبب الخطأ                          تحياتى

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

فيه طريقة بدون أكواد يدوية يعنى قد تكون أسهل الآن

من قائمة  review         نختار   protect workbook

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

عمل حفظ  من save

هذا يمنع النسخ والقص والاخفاء  واعادة التسمية بالنسبة للشيتات

أيضا يمكن عمل حماية أخرى للشيتات من  من قائمة  review         نختار protect sheet  

من المربع الحوارى اكتبى كلمة سر واختارى من المربع الحوارى ماتريدينه

ثم أكدى كلمة السر ثانية ً فى المربع الحوارى التالى ثم حفظ

تم تعديل بواسطه مختار حسين محمود
رابط هذا التعليق
شارك

الاخت الكريمه
الخطوات اللى ذكرتيه صحيح لكن مش عارفه انتى طبقتيها صح ام لا
عموما اتبعى الخطوات التالية

1- حذف الكود اللى موجود فى  حدث ThisWorkbook هتعملى دبل كليك على ThisWorkbook هتلاقى الكود اللى انتى قمتى بنسخه قبل كدا  المطلوب بقى تحذفيه معلش هتعبك معايا (بالبلدى مش عايزين الخطوة دى مستغنيين عنها )
كدا حدث ThisWorkbook شاشة بيضا رجعت تانى بدون ما يكون فيها اى كود
2- المفترض انى عندك كودين دلوقتى كل كود فى مودويل صح 

طيب دبل كليك على كل مودويل واحذفى الكود اللى فيه تمام كدا الملف بدون اكواد 

هتردى تقولى دا فى كود من ضمنهم بتاع اخفاء الاشرطه والقوائم صح عادى احذفيهم بس 

3- قومى بنسخ الكود التالى فى اى مودويل من اللى فاضيين انتى عندك 2 انسخى الكود ده والصقيه فى واحد من اى مودويل

Public xx As Integer
Public x As Integer
Sub Auto_Open()
Application.ScreenUpdating = False

kh_wVisible True
Application.ScreenUpdating = False
ActiveWindow.DisplayWorkbookTabs = False
Application.DisplayFormulaBar = False

Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",false)"
Call ToggleCutCopyAndPaste(False)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic



End Sub

Sub Auto_Close()
Dim i As Integer
kh_wVisible False
ThisWorkbook.Close Not CBool(ThisWorkbook.Saved)
Application.DisplayFormulaBar = True
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
Call ToggleCutCopyAndPaste(True)

End Sub
Sub kh_wVisible(ibol As Boolean)
Dim nBook As String
nBook = ThisWorkbook.Name
With Windows(nBook)
    If .Visible = Not ibol Then .Visible = ibol
End With
End Sub
Sub unhide_toolbar()
xx:

Dim x
x = InputBox("لأظهار القوائم يتطلب كلمة مرور" & Chr(13) & "الرجاء ادخال كلمة مرور", "كلمة مرور")
If IsNull(x) Or x = "" Then GoTo xx


If x = "111" Then
ActiveWindow.DisplayWorkbookTabs = True

Application.DisplayFormulaBar = True
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
Else
MsgBox "كلمة المرور غير صحيحه" & Chr(13) & " الرجاء اعادة ادخال كلمة المرور ", vbOKOnly
End If

End Sub

Sub hide_toolbar()
ActiveWindow.DisplayWorkbookTabs = False
Application.DisplayFormulaBar = False

Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",false)"

End Sub
Sub تفعيل_النسخ()
xx:

Dim x
x = InputBox("لتفعيل النسخ يتطلب" & Chr(13) & "الرجاء ادخال كلمة المرور", "كلمة مرور")
If IsNull(x) Or x = "" Then GoTo xx


If x = "111" Then
Call ToggleCutCopyAndPaste(True)

Else
MsgBox "كلمة المرور غير صحيحه" & Chr(13) & " الرجاء اعادة ادخال كلمة المرور ", vbOKOnly
End If

End Sub

Sub منع_النسخ()
Call ToggleCutCopyAndPaste(False)
End Sub

4-قومى بنسخ الكود التالى والصقيه فى المودويل التانى 

Option Explicit

Sub ToggleCutCopyAndPaste(Allow As Boolean)
'Activate/deactivate cut, copy, paste and pastespecial menu items
    Call EnableMenuItem(21, Allow)    ' cut
    Call EnableMenuItem(19, Allow)    ' copy
    Call EnableMenuItem(22, Allow)    ' paste
    Call EnableMenuItem(755, Allow)   ' pastespecial

'Activate/deactivate drag and drop ability
    Application.CellDragAndDrop = Allow

'Activate/deactivate cut, copy, paste and pastespecial shortcut keys
    With Application
        Select Case Allow
            Case Is = False
                .OnKey "^c", "CutCopyPasteDisabled"
                .OnKey "^v", "CutCopyPasteDisabled"
                .OnKey "^x", "CutCopyPasteDisabled"
                .OnKey "+{DEL}", "CutCopyPasteDisabled"
                .OnKey "^{INSERT}", "CutCopyPasteDisabled"
            Case Is = True
                .OnKey "^c"
                .OnKey "^v"
                .OnKey "^x"
                .OnKey "+{DEL}"
                .OnKey "^{INSERT}"
            End Select
    End With
End Sub

Sub EnableMenuItem(ctlId As Integer, Enabled As Boolean)
     'Activate/Deactivate specific menu item
    Dim cBar As CommandBar
    Dim cBarCtrl As CommandBarControl
    For Each cBar In Application.CommandBars
        If cBar.Name <> "Clipboard" Then
            Set cBarCtrl = cBar.FindControl(ID:=ctlId, recursive:=True)
            If Not cBarCtrl Is Nothing Then cBarCtrl.Enabled = Enabled
        End If
    Next
End Sub
 
Sub CutCopyPasteDisabled()
'Inform user that the functions have been disabled
    MsgBox "نأسف تم تعطيل النسخ واللصق والحذف بالملف!"
End Sub

5-انتى كان عندك زرين واحد بتاع اظهار القوائم والثانى بتاع اخفاء القوائم 

دلوقتى هتعملى زرين كمان علشان يكونو 4 ازرار 

الزرين الجداد دول واحد هتعينى علية ماكرو تفعيل_النسخ  ( يعنى هتقفى على الزر كليك يمين هتظهر قائمة اختارى تعيين ماكرو ثم هتظهر قائمة اختارى تفعيل_ النسخ)

والثانى هتعينى عليه ماكرو منع _النسخ ( يعنى هتقفى على الزر كليك يمين هتظهر قائمة اخارى تعيين ماكرو ثم هتظهر قائمة اختارى منع_ النسخ)

جربى وعلمينى بالنتيجة

تقبلى تحياتى

مرفق ملف للتطبيق

اخفاء شريط الصفحات - Copy.zip

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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information