تعطيل عمل زر ماكرو

[الشيباني1]

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

Book1.zip

[عبد الفتاح كيرة]

فى بداية الكود أضف السطر التالى

If InputBox(" your pass") = "123" Then

وقبل end sub أضف end if ليصبح الكود

Sub ãÇßÑæ1()

'

' ãÇßÑæ1 ãÇßÑæ

' ÇáãÇßÑæ ãÓÌá ý11/01/2011 ÈæÇÓØÉ ýUSER

'

'

If InputBox(" your pass") = "123" Then




    Range("C3:H17").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .Weight = xlMedium

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .Weight = xlMedium

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .Weight = xlMedium

        .ColorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .Weight = xlMedium

        .ColorIndex = xlAutomatic

    End With

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    With Selection.Interior

        .ColorIndex = 36

        .Pattern = xlSolid

    End With

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Selection.Merge

    End If

End Sub

[الشيباني1]

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

[عبد الفتاح كيرة]

الكود التالى لإخفاء الورقة

Sub hido()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

If ws.Name = "ورقة1" Then

ws.Visible = xlSheetHidden

End If

Next ws

End Sub

وهذا لإظهاره مع المطالبة بكلة السر 123

Sub showo()

Dim ws As Worksheet

If InputBox(" your pass") = "123" Then

For Each ws In ThisWorkbook.Worksheets

If ws.Name = "ورقة1" Then

ws.Visible = xlSheetVisible

End If

Next ws

End If


End Sub

المرفق

كود إظهار و إخفاء أوراق العمل بكلمة سر - kemas.rar

[الشيباني1]

اشكرك اخي العزيز وجزاك الله كل خير