Bonjour le Forum,
Je souhaite appliquer une macro interdisant l'impression et le copier/coller à tous les classeurs d'un même dossier.
Je sui parti d'une macro proposée par Roland_M
La macro interdire copier/coller fonctionne correctement mais je bloque sur l'interdiction de l'impression du fait de la nécessité d'ecrire la macro dans 'this Workbook'.
Merci par avance pour votre aide
Voici le code :
Je souhaite appliquer une macro interdisant l'impression et le copier/coller à tous les classeurs d'un même dossier.
Je sui parti d'une macro proposée par Roland_M
La macro interdire copier/coller fonctionne correctement mais je bloque sur l'interdiction de l'impression du fait de la nécessité d'ecrire la macro dans 'this Workbook'.
Merci par avance pour votre aide
Voici le code :
Code:
Public Chemin, Fich As String, ReponseMsgBox As Variant
' .
'routine d'appel depuis le bouton sur feuille
' .
Public Sub SelectionnerRepertoire()
Chemin = FLoadNomDuREP: Chemin = Trim(Chemin): If Chemin = "" Then Exit Sub
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
DoEvents
'demande de confirmation
M$ = "Traiter tous les Fichiers xls du répertoire suivant :" & vbLf & Chemin & vbLf & vbLf & "Veuillez confirmer ?"
ReponseMsgBox = MsgBox(M$, vbQuestion + vbYesNo, "Traitement des fichiers")
If ReponseMsgBox = vbYes Then
BoucleDeTraitement ' appel la routine de traitement des fichiers
MsgBox "Traitement terminé !", vbInformation
Else
MsgBox "Traitement abandonné !", vbExclamation
End If
End Sub
' , &H1&)=avec bouton "créer un nouveau dossier" ... , $H201&)=sans le bouton
'objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&, RepDefaut)
Private Function FLoadNomDuREP() As String
Dim objShell As Object, objFolder As Object, REP As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&)
If Not objFolder Is Nothing Then
REP = objFolder.Items.Item.Path
If Right(REP, 1) <> "\" Then REP = REP & "\"
End If
FLoadNomDuREP = REP
Set objShell = Nothing: Set objFolder = Nothing
End Function
' .
' .
Private Sub BoucleDeTraitement() ' la boucle de traitement des fichiers
Application.ScreenUpdating = False
ChDir Chemin
Fich = Dir(Chemin & "*.xls")
Do While Fich <> ""
Workbooks.Open Chemin & Fich
InterdireCopierCouper
ActiveWorkbook.Close True
Fich = Dir
With Workbooks.Open Chemin & Fich.VBProject.VBComponents("This Workbook").CodeModule
.AddFromString VBA
Workbook_BeforePrint
ActiveWorkbook.Close True
End With
Loop
Application.ScreenUpdating = True
End Sub
Sub InterdireCopierCouper()
On Error Resume Next
With Application
'disables shortcut keys
.OnKey "^c", ""
.OnKey "^v", ""
.OnKey "^x", ""
'Disables Copy
.CommandBars("Edit").FindControl(ID:=19).Enabled = False
.CommandBars("Edit").FindControl(ID:=848).Enabled = False
.CommandBars("Cell").FindControl(ID:=19).Enabled = False
.CommandBars("Column").FindControl(ID:=19).Enabled = False
.CommandBars("Row").FindControl(ID:=19).Enabled = False
.CommandBars("Button").FindControl(ID:=19).Enabled = False
.CommandBars("Formula Bar").FindControl(ID:=19).Enabled = False
.CommandBars("Worksheet Menu Bar").FindControl(ID:=19).Enabled = False
.CommandBars("Standard").FindControl(ID:=19).Enabl ed = False
.CommandBars("Button").FindControl(ID:=848).Enable d = False
.CommandBars("Formula Bar").FindControl(ID:=848).Enabled = False
.CommandBars("Worksheet Menu Bar").FindControl(ID:=848).Enabled = False
.CommandBars("Standard").FindControl(ID:=848).Enab led = False
.CommandBars("Ply").FindControl(ID:=848).Enabled = False
'Disables Cut
.CommandBars("Edit").FindControl(ID:=21).Enabled = False
.CommandBars("Cell").FindControl(ID:=21).Enabled = False
.CommandBars("Column").FindControl(ID:=21).Enabled = False
.CommandBars("Row").FindControl(ID:=21).Enabled = False
.CommandBars("Button").FindControl(ID:=21).Enabled = False
.CommandBars("Formula Bar").FindControl(ID:=21).Enabled = False
.CommandBars("Worksheet Menu Bar").FindControl(ID:=21).Enabled = False
.CommandBars("Standard").FindControl(ID:=21).Enabl ed = False
End With
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True
MsgBox "Vous n'avez pas la possibilité d'imprimer ce document"
End Sub