الطباعة من الزر فقط، أي حصر الطباعة على البوتون و منعها بدونه

[عربي مسلم]

السلام عليكم إخواني الكرام

عندي كود طباعة شغال 10/10 بواسطة زر أي بوتون

هذا هو الكود, في الشيت رقم 3 sheet

Sub Imprission()
Dim r As Range
Set r = ActiveSheet.UsedRange
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TEST, openafterpublish:=True
With ActiveSheet.PageSetup
If r.Width > 595.3 Then
.Orientation = xlPortrait
Else
.Orientation = xlPortrait
End If
End With
ActiveSheet.PrintOut Copies:=1
End Sub
حاولت أن أجعل هذا الكود هو مفتاح الطباعة الوحيد فبحثت عن كود لألغي به الطباعة من دونه، فوجدت كود، لكنه للأسف يمنع الطباعة بشكل كلي، هذا الكود جعلته في الووركبوك thisworkbook
Private Sub Workbook_BeforePrint(Cancel As Boolean)
MsgBox "Rappel... Passez par un bouton IMPRIMER"
Cancel = True
End Sub

و بارك الله في الجميع

[عبدللرحيم]

تفضل جرب المرفق الخاص بك

ملف جديد (2).xlsm

[عربي مسلم]

 

جزاك الله خيرا و بارك فيك عبدللرحيم,شكرا جزيييلا على تفاعلك و ردك الجميل ذي الذوق الأصيل أنك أرفقته بملف أرسلته أنا قبل مدة,فهدا شيء رائع من قبلك,بارك الله فيك.

الكود الذي أحتاجه لا يطبع إلا من الزر و فقط لا من إختصار طباعة أو غيره,و الحمد لله وجدت الحل بالتحايل و الحيلة لتجاوز كود المنع, و دونك الكود فلعل أحدا من أعضاء هذا الجمع الكريم في هذا المنتدى المميز أن يجد فيه ضالة ينشدها.و الشكر موصول للأخ المميز أبو عائشة حسونة hassona229.

يوضع هذا الكود في thisworkbook

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If ActiveSheet.Range("B200").Value = "" Then
MsgBox "Rappel... Passez par un bouton Imprission"
Cancel = True
Else
Cancel = False
End If
End Sub

يوضع هذا الكود في module
Sub Imprission()
Dim r As Range
Set r = ActiveSheet.UsedRange
ActiveSheet.Range("B200").Value = "1"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TEST, openafterpublish:=True
ActiveSheet.Range("af5").Value = ""
With ActiveSheet.PageSetup
If r.Width > 595.3 Then
.Orientation = xlPortrait
Else
.Orientation = xlPortrait
End If
End With
ActiveSheet.PrintOut Copies:=1
ActiveSheet.Range("B200").Value = ""
End Sub