كود الطباعة

[ياسر فاروق]

الساده الافاضل

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

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

Private Sub Workbook_BeforePrint(Cancel As Boolean)
motpass = "123!@"
q1 = InputBox("Please enter your password!")
If q1 <> motpass Then
MsgBox ("Please enter your valid password!!"), vbCritical
Cancel = True
End If

End Sub

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

برجاء المساعده وشكرا

 

[علي حيدر]

يجب الحفظ باسم مثال exmpel.xlsm يعمل معك الملف باذن الله

[ياسر فاروق]

14 ساعات مضت, علي حيدر said:

يجب الحفظ باسم مثال exmpel.xlsm يعمل معك الملف باذن الله

شكرا على اهتمامك ووقتك

ولكنى لم أجد فى الحفظ باسم ما تشير إليه (عندى اوفيس 2010)

المشكلة هى فى - الحفظ باسم - اذ تم إلغاؤها من قائمة الاكسيل يكون أفضل

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

Sub Auto_Close()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

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)

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

[علي حيدر]

اخي هذا الكود لا يعمل لا نه غير مكتمل مفقود كود . ضع الكود الاتي في حدث الملف  

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim motpass As Variant
Dim AAAA As Variant
Dim MS As Variant
AAAA = MsgBox("" & "Do you really want Printing this sheet?" & "", vbYesNo, "Prenting")
If AAAA = vbNo Then
Cancel = True
Exit Sub
Else
End If
motpass = Application.InputBox("Please enter your password!", "Prenting ")
If motpass <> 3 Then
motpass = Application.InputBox("Please enter your password!", "Prenting ")
MS = MsgBox("The password is incorrect", , "Prenting")
Cancel = True
Exit Sub
Else
End If
 End Sub
 هذا الكود خاص بي يعمل مئة بالمئة

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

البسورد رقم 3

 

[ياسر فاروق]

في ‏٣٠‏/‏٠٨‏/‏٢٠١٧ at 18:08, علي حيدر said:

اخي هذا الكود لا يعمل لا نه غير مكتمل مفقود كود . ضع الكود الاتي في حدث الملف  

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim motpass As Variant
Dim AAAA As Variant
Dim MS As Variant
AAAA = MsgBox("" & "Do you really want Printing this sheet?" & "", vbYesNo, "Prenting")
If AAAA = vbNo Then
Cancel = True
Exit Sub
Else
End If
motpass = Application.InputBox("Please enter your password!", "Prenting ")
If motpass <> 3 Then
motpass = Application.InputBox("Please enter your password!", "Prenting ")
MS = MsgBox("The password is incorrect", , "Prenting")
Cancel = True
Exit Sub
Else
End If
 End Sub
 هذا الكود خاص بي يعمل مئة بالمئة

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

البسورد رقم 3

 

أخى العزيز / على حيدر

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

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

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

الكود الأول يعمل على الطباعة بكلمة سر

Private Sub Workbook_BeforePrint(Cancel As Boolean)
motpass = "123!@"
q1 = InputBox("Please enter your password!")
If q1 <> motpass Then
MsgBox ("Please enter your valid password!!"), vbCritical
Cancel = True
End If

End Sub

الكود الثانى يقفل قوائم الاكسيل

Sub Auto_Close()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

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)

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

اريد جمع الكودين ليعملوا فى الملف

 

وشكرا مره أخرى

[علي حيدر]

تفضل اخي ارجو ان يكون طلبك هذا الحل

Private Sub Workbook_BeforePrint(CancelAs Boolean)

motpass = "123!@"

call auto_close
q1 = InputBox("Please enter your

password!")
If q1 <> motpass Then
MsgBox ("Please enter your valid password!!"), vbCritical
Cancel = True

call auto_close
End If

 

End Sub

 

Sub Auto_Close()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

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)

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub