حماية الخلايا

[ahmedhossin]

السلام عليكم و رحمة الله و بركاته عندي برنامج بالميكرو ( فيه صيغ البحث )  و لكن عندما اريد ان احمي البرنامج 

الميكرو البحث لا يعمل اريد حماية فقط للصفحة التي فيها المعلومات ( ملاحظة الورقة التي فيها البرنامج و ورقة الميكرو للبحث في نفس الورقة )

المرفقات مرفقة  كود هو 0000

 

التقرير-اليومي-للاستشارة التربوية 2022 مبرمج.xlsm

[محمد هشام.]

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

تفضل اخي 

Sub Recherche()
Dim lastrow As Long, Col As Long

Set wsdest = ThisWorkbook.Sheets("Feuil1")
Set wsdata = ThisWorkbook.Sheets("Feuil2")

lastrow = wsdata.Cells(Rows.Count, "C").End(xlUp).Row
If Application.WorksheetFunction.CountA(wsdest.Range("AE7:AM7")) = 0 Then
  
  MsgBox "!!!المرجوا إدخال معايير الفلترة " & vbCrLf, vbInformation + vbOKOnly, " ! تنبيه"
           
        Exit Sub
    End If
    
Application.ScreenUpdating = False
' إلغاء حماية الورقة
wsdest.Unprotect "0000"
If wsdest.AutoFilterMode Then wsdest.AutoFilterMode = False
Col = wsdest.Cells(Rows.Count, "AE").End(xlUp).Row

' افراغ البيانات السابقة
wsdest.Range("AE15:AM" & Col).Clear 'Contents
'نطاق الفلترة
        wsdata.Range("C27:K" & lastrow).AdvancedFilter _
          Action:=xlFilterCopy, _
           CriteriaRange:=wsdest.Range("AE6:AM7"), _
             CopyToRange:=wsdest.Range("AE14:AM14"), _
        Unique:=True
    
If Application.WorksheetFunction.CountA(wsdest.Range("AE15:AM15")) = 0 Then
résultat = MsgBox("ليس هناك بيانات مطابقة لمعايير الفلترة الحالية", vbOKOnly + vbCritical + vbDefaultButton1 + vbApplicationModal, "انتباه")

End If

On Error Resume Next
' اخفاء الصيغ
    wsdest.UsedRange.SpecialCells(xlCellTypeFormulas).FormulaHidden = True
    On Error GoTo 0

' ارجاع الحماية لورقة العمل
    wsdest.Protect "0000"

    Application.ScreenUpdating = True
End Sub

 

التقرير-اليومي 2022 مبرمج.xlsm