طلب اضافة كلمة سر لحدف فاتورة

[عبدالواحد احمد]

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

 

الاساتذة الافاضل طلب تعديل هد الكوادلحدف الفاتورة  اريد لما اضغط على زر الحدف يطلب مني ادخال كلمة سر

ليتم مسح الفاتورة

 

االود الاول

 

Sub invoice_cleer()
'مسح كامل بيانات الفاتورة و اضافة  رقم فاتورة
Sheets("invoice").Select
Sheets("invoice").Unprotect
Range("E3,I3,E5").ClearContents
Range("D10:J60").ClearContents

Range("E3").FormulaR1C1 = "=NOW()"
Range("F3").FormulaR1C1 = "=R3C5"
'Range("I10:I59").FormulaR1C1 = "=SUM(RC8*RC7)"
'Range("I10:I60").FormulaR1C1 = "=SUM(RC8*RC7)"
ActiveSheet.PageSetup.PrintArea = "$B$2:$K$65"
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.Zoom = 60
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayGridlines = False
ActiveWindow.LargeScroll Down:=-99
ActiveWindow.LargeScroll ToRight:=99
Range("I3") = Range("L3")
Range("E5").Select
    
    
End Sub

كود التاني

Sub invoice_Kill()
' حذف بيانات فاتورة
Application.ScreenUpdating = False
Set Ws = Worksheets("INVOICE")
Set WS1 = Worksheets("Customers")
LR1 = WS1.Range("c55555").End(xlUp).Row + 1
If Ws.Range("J3") = "" Then GoTo 6
For FR = 10 To 60
LR1 = Val(Ws.Cells(FR, 12))
If Ws.Cells(FR, 12) = "" Then GoTo 7

WS1.Range("E" & LR1 & ":M" & LR1).ClearContents
LR1 = LR1 + 1
7 Next FR

Application.CutCopyMode = False
Ws.Select
Application.ScreenUpdating = True
6 MsgBox "تم حذف بيانات الفاتورة THIS BILL DELETED"
Application.Run "invoice_cleer"

On Error Resume Next
    Range("I60:I64").SpecialCells(xlCellTypeConstants).ClearContents
On Error GoTo 0
End Sub

 

تم تعديل نوفمبر 5, 2015 بواسطه دغيدى

[عبدالواحد احمد]

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

 

الاساتذة الافاضل هل من اضافة  لكود الحدف اريد لما اضغط على زرالحدف يطلب مني ادخال كلمت سر ليتم المسح

الفا تورة

جزاكم الله خيرًا و زادها بميزان حسناتكم

تم تعديل نوفمبر 5, 2015 بواسطه عبدالواحد احمد

[عبد العزيز البسكري]

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

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

فائق إحتراماتي

تم تعديل نوفمبر 6, 2015 بواسطه عبد العزيز البسكري

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

Dim x
    x = InputBox("Type your password here.", "Password Required")
    If x = "123" Then
 ضع كودك هنا اخي الغالي
        Else
        MsgBox "كلمة المرور خطأ يرجى اعادة المحاولة"
    End If

 

ليصبح هكذا

الكود الاول

Sub invoice_cleer()
'مسح كامل بيانات الفاتورة و اضافة  رقم فاتورة
Dim x
    x = InputBox("Type your password here.", "Password Required")
    If x = "123" Then
Sheets("invoice").Select
Sheets("invoice").Unprotect
Range("E3,I3,E5").ClearContents
Range("D10:J60").ClearContents

Range("E3").FormulaR1C1 = "=NOW()"
Range("F3").FormulaR1C1 = "=R3C5"
'Range("I10:I59").FormulaR1C1 = "=SUM(RC8*RC7)"
'Range("I10:I60").FormulaR1C1 = "=SUM(RC8*RC7)"
ActiveSheet.PageSetup.PrintArea = "$B$2:$K$65"
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.Zoom = 60
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayGridlines = False
ActiveWindow.LargeScroll Down:=-99
ActiveWindow.LargeScroll ToRight:=99
Range("I3") = Range("L3")
Range("E5").Select
    Else
        MsgBox "كلمة المرور خطأ يرجى اعادة المحاولة"
    End If   
End Sub

 

الكود الثاني

Sub invoice_Kill()
' حذف بيانات فاتورة
Dim x
    x = InputBox("Type your password here.", "Password Required")
    If x = "123" Then
Application.ScreenUpdating = False
Set Ws = Worksheets("INVOICE")
Set WS1 = Worksheets("Customers")
LR1 = WS1.Range("c55555").End(xlUp).Row + 1
If Ws.Range("J3") = "" Then GoTo 6
For FR = 10 To 60
LR1 = Val(Ws.Cells(FR, 12))
If Ws.Cells(FR, 12) = "" Then GoTo 7

WS1.Range("E" & LR1 & ":M" & LR1).ClearContents
LR1 = LR1 + 1
7 Next FR

Application.CutCopyMode = False
Ws.Select
Application.ScreenUpdating = True
6 MsgBox "تم حذف بيانات الفاتورة THIS BILL DELETED"
Application.Run "invoice_cleer"

On Error Resume Next
    Range("I60:I64").SpecialCells(xlCellTypeConstants).ClearContents
On Error GoTo 0

 Else
        MsgBox "كلمة المرور خطأ يرجى اعادة المحاولة"
    End If   
End Sub

 

والافضل  كما قالي اخي الغالي

عبد العزيز البسكري يرجى وضع مرفق بالتوضيح حتى يتمكن اكبر عدد من الاساتذة من مساعدتك

 

[عبدالواحد احمد]

اخي عبد العزيز البسكري  كان بي ودي رفع املف لكن الملف كبر

سوف اجيد طريقة لرفع الملف ان ساء الله

تم تعديل نوفمبر 6, 2015 بواسطه عبدالواحد احمد

[عبدالواحد احمد]

حدف فاتورة باسورد.zip

[عبد العزيز البسكري]

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

أخي الكريم عبد الواحد أحمد .. الإضافة المميّزة للأستاذ القدير ياسر العربي تعمل بشكل ممتاز .. جزاه الله خيرًا و زادها بميزان حسناته

قمت بوضعها بالملف رقم 1 .. و أضفت لك ملفين .. و الملفات الثلاث المختلفة الجزئيات تعمل بشكل ممتاز و قمت بتجربتها .. جرّب و أخبرنا لو تكرّمت

فائق إحتراماتي

 

كلمة المرور للماكرو.rar

[عبدالواحد احمد]

[عبد العزيز البسكري]

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

طيّب أخي الكريم عبد الواحد أحمد .. المشكلة التي أشرت إليها بأي ملف ظهرت ؟؟

على كلّ حال .. تفضّل للإضافة و لتنويع الطرق كلمة المرور للماكرو بثلاث محاولات .. و إذا كانت المحاولة الثالثة خاطئة سيتم الخرورج من الملف نهائيا "ممنوع التلاعب بالفواتير"

الكود تم وضعه في حدث الشيت المقصود و ليس كموديل ..

 

 

 

حدف فاتورة باسورد 4.rar

[عبدالواحد احمد]

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

أخى الحبيب الغالى / عبد العزيز السكرى

 

أخي الكريم ..  للأستاذ القدير ياسر العربي

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

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

2 hours ago, عبد العزيز البسكري said:

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

طيّب أخي الكريم عبد الواحد أحمد .. المشكلة التي أشرت إليها بأي ملف ظهرت ؟؟

على كلّ حال .. تفضّل للإضافة و لتنويع الطرق كلمة المرور للماكرو بثلاث محاولات .. و إذا كانت المحاولة الثالثة خاطئة سيتم الخرورج من الملف نهائيا "ممنوع التلاعب بالفواتير"

الكود تم وضعه في حدث الشيت المقصود و ليس كموديل ..

 

 

 

حدف فاتورة باسورد 4.rar

اضافات جميلة اخي الغالي عبد العزيز البسكري

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

ملحوظة صغيرة للاخ الغالي عبد الواحد

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

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

الكلام ليس لك وحدك اخي الغالي بل لمعظم من يتجاهل رد منا  عن طريق السهو او الخطأ او عمدا ارجو مراجعه الردود جيدا

وشكرا

   

[عبد العزيز البسكري]

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

أقسم لك برب المخلوقات أنّ لك نفس تفكيري .. و ألعن اللّحظة التي نظرت فيها إلى أي مرفق و لو على سبيل الاطّلاع لشخص مهما كان لا يعيرني إهتمامًا و لو بكلمة طيّبة " بارك الله فيك" فهذه أحسن صدقة ..

بالنيابة عنه و بالنيابة عن أي شخص تجاهل تدخّلاتك المميّزة

آسف .. جد آسف أستاذي القدير ياسر العربي

فائق إحتراماتي

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

1 minute ago, عبد العزيز البسكري said:

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

أقسم لك برب المخلوقات أنّ لك نفس تفكيري .. و ألعن اللّحظة التي نظرت فيها إلى أي مرفق و لو على سبيل الاطّلاع لشخص مهما كان لا يعيرني إهتمامًا و لو بكلمة طيّبة " بارك الله فيك" فهذه أحسن صدقة ..

بالنيابة عنه و بالنيابة عن أي شخص تجاهل تدخّلاتك المميّزة

آسف .. جد آسف أستاذي القدير ياسر العربي

فائق إحتراماتي

اخي الغالي عبد العزيز البسكري

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

ثانيا  اخي عبد العزيز انا من اشد المعجبين بتفاعلاتك الجميلة داخل هذا الصرح العظيم

واتمنى من الله ان تكون في مكانه متميزه بيننا باذن الله

 

[عبدالواحد احمد]

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

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

تمت الترقية الي الاصدار 4.1 - يرجي عمل ريفريش عند الدخول لاول مرة   05 نوف, 2015

السلام عليكم تمت الان الترقية اذا واجهتكم مشكلة يرجي عامل ريفريش  Ctr+F5

فعلن آسف .. جد آسف أستاذي القدير ياسر العربي

فائق إحتراماتي

تم تعديل نوفمبر 6, 2015 بواسطه عبدالواحد احمد