Bonjour le forum,
J'ai réalisé une macro permettant d'envoyer, entre autres, des fichiers Excel par mail.
Le principe est que le contrôleur établit une "fiche anomalie", lui donne un nom automatiquement, et l'envoie ensuite par mail au responsable du Service concerné par l'anomalie.
Je souhaite que :
- le fichier ainsi envoyé soit protégé, de manière à ce que le technicien ne puisse qu'indiquer la date et son nom (cellules B46 et E46) ;
- les macros soient désactivées.
Or, même si le code est présent (FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveSheet.Protect "Controle"),
cela ne fonctionne pas.
En effet, les macros sont toujours activées et rien n'est protégé dans la macro.
Si quelqu'un pouvait me donner un coup de main.
Je joins un fichier test et l'ensemble de la macro (voir, plus spécifiquement, la macro Sub EnregImprim()).
Merci d'avance.
Cordialement.
J'ai réalisé une macro permettant d'envoyer, entre autres, des fichiers Excel par mail.
Le principe est que le contrôleur établit une "fiche anomalie", lui donne un nom automatiquement, et l'envoie ensuite par mail au responsable du Service concerné par l'anomalie.
Je souhaite que :
- le fichier ainsi envoyé soit protégé, de manière à ce que le technicien ne puisse qu'indiquer la date et son nom (cellules B46 et E46) ;
- les macros soient désactivées.
Or, même si le code est présent (FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveSheet.Protect "Controle"),
cela ne fonctionne pas.
En effet, les macros sont toujours activées et rien n'est protégé dans la macro.
Si quelqu'un pouvait me donner un coup de main.
Je joins un fichier test et l'ensemble de la macro (voir, plus spécifiquement, la macro Sub EnregImprim()).
Merci d'avance.
Cordialement.
Code:
Sub NumerAuto()
Dim fso As Object, chemin As String, f As Object, i As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
chemin = "G:\XXXX\YYYY\ZZZZ\2013\AAAA\BBBB\"
i = 1
'Cells(i, 1) = "Sous dossiers"
'Cells(i, 2) = "Nb fichiers"
For Each f In fso.GetFolder(chemin).SubFolders
i = i + 1
'Cells(i, 1) = f.Name
Cells(i, 6) = f.Files.Count
'x = x + f.Files.Count
Next f
End Sub
Sub Enreg()
Dim chemin As String, Chemin2 As String, Repertoire As String, Fichier As String, Fichier2 As String, Fichier4 As String, Rep As String
Dim pl As Range
Dim i As Long
Dim cel As Range
chemin = "G:\XXXX\YYYY\ZZZZ\2013\AAAA\BBBB\"
Chemin2 = "G:\XXXX\YYYY\ZZZZ\2013\AAAA\"
Repertoire = Range("A9").Value & "\"
Fichier = "Test.xlsm"
Fichier2 = Sheets("Feuil2").Range("E1").Value & ".xlsx"
Fichier4 = "Extraction.xlsx"
ActiveWorkbook.SaveAs Filename:=chemin & Repertoire & Fichier2, FileFormat:=xlOpenXMLWorkbookMacroEnabled
With Sheets("Feuil2")
'définit la plage pl des données que l’on veut importer
Set pl = Application.Union(.Cells(8, 5), .Cells(9, 1), .Cells(9, 2), .Cells(9, 5), .Cells(13, 2), .Cells(15, 2), .Cells(15, 5), .Cells(17, 2), .Cells(17, 5))
End With
Workbooks.Open Chemin2 & Fichier4
Application.AskToUpdateLinks = False
ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources
'Workbooks(Chemin2 & Fichier4).Activate
With ActiveWorkbook.Sheets("Feuil1")
i = .UsedRange.Rows.Count 'compte le nombre de lignes déjà utilisées dans ce fichier
décalageColonne = 0
For Each cel In pl
cel.Copy .Cells(i + 1, 1 + décalageColonne)
décalageColonne = décalageColonne + 1
Next cel
End With
ActiveWorkbook.Close SaveChanges:=True
Rep = MsgBox("Voulez-vous revenir au modèle et fermer la présente fiche anomalie ?", vbYesNo + vbQuestion, "Le programme demande votre attention")
If Rep = vbYes Then
Workbooks.Open Filename:=chemin & Fichier
Workbooks(Fichier2).Close SaveChanges:=False
End If
End Sub
Sub EnregImprim()
Dim chemin, Repertoire, Fichier, Fichier2, Rep As String
chemin = "G:\XXXX\YYYY\ZZZZ\2013\AAAA\BBBB\"
Repertoire = [A9].Value & "\"
Fichier = "Test.xlsm"
Fichier2 = Sheets("Feuil2").[E1].Value & ".xlsx"
ActiveWorkbook.SaveAs Filename:=chemin & Repertoire & Fichier2, FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveSheet.PrintOut
Rep = MsgBox("Voulez-vous revenir au modèle et fermer la présente fiche anomalie ?", vbYesNo + vbQuestion, "Le programme demande votre attention")
If Rep = vbYes Then
Workbooks.Open Filename:=chemin & Fichier
Workbooks(Fichier2).Close SaveChanges:=False
End If
End Sub
Sub Imprim()
ActiveSheet.PrintOut
End Sub
Sub EnregMail()
Dim chemin, Repertoire, Fichier, Fichier2, Rep, destinataire1, destinataire2, destinataire3, destinataire4, destinataire5, cc, body, sujet, strcommand, fichierjoint As String
destinataire1 = "b.pratiot@zouzou.fr"
destinataire2 = "p.mokal@zouzou.fr"
destinataire3 = "x.boggie@zouzou.fr"
destinataire4 = "p.prazuline@zouzou.fr"
destinataire5 = "c.barchot@zouzou.fr"
cc = "controle@zouzou.fr"
chemin = "G:\XXXX\YYYY\ZZZZ\2013\AAAA\BBBB\"
Repertoire = [A9].Value & "\"
Fichier = "Test.xlsm"
Fichier2 = Sheets("Feuil2").[E1].Value & ".xlsm"
Fichier3 = Sheets("Feuil2").[E1].Value & ".xlsm"
fichierjoint = chemin & Repertoire & Fichier3
ActiveWorkbook.SaveAs Filename:=chemin & Repertoire & Fichier2, FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveSheet.Protect "Controle"
If [A9].Value = "A" Then
sujet = "Fiche anomalie"
body = "<HTML><BODY>Bonjour" & "," & "<br>" & "<br>" & "Nous vous prions de trouver ci-joint" & ", " & _
"une fiche anomalie concernant la saisie d'un technicien de votre service." & _
" Nous vous remercions de lui transmettre ladite fiche et de lui demander de régulariser le dossier dans les meilleurs délais." & _
"<br>" & "<br>" & "<br>" & "Bien cordialement." & "<br>" & "<br>" & "<br>" & "<br>" & "Le Service Contrôle.</BODY></HTML>"
strcommand = "C:\Program Files\Mozilla Thunderbird\thunderbird"
strcommand = strcommand & " -compose " & "to='" & destinataire1 & "'"
strcommand = strcommand & "," & "cc='" & cc & "'"
strcommand = strcommand & "," & "subject='" & sujet & "',format='1',"
strcommand = strcommand & "body='" & body & "'"
strcommand = strcommand & "," & "attachment='file:///" & fichierjoint & "'"
Call Shell(strcommand, vbNormalFocus)
End If
If [A9].Value = "B" Then
sujet = "Fiche anomalie"
body = "<HTML><BODY>Bonjour" & "," & "<br>" & "<br>" & "Nous vous prions de trouver ci-joint" & ", " & _
"une fiche anomalie concernant la saisie d'un technicien de votre service." & _
" Nous vous remercions de lui transmettre ladite fiche et de lui demander de régulariser le dossier dans les meilleurs délais." & _
"<br>" & "<br>" & "<br>" & "Bien cordialement." & "<br>" & "<br>" & "<br>" & "<br>" & "Le Service Contrôle.</BODY></HTML>"
strcommand = "C:\Program Files\Mozilla Thunderbird\thunderbird"
strcommand = strcommand & " -compose " & "to='" & destinataire2 & "'"
strcommand = strcommand & "," & "cc='" & cc & "'"
strcommand = strcommand & "," & "subject='" & sujet & "',format='1',"
strcommand = strcommand & "body='" & body & "'"
strcommand = strcommand & "," & "attachment='file:///" & fichierjoint & "'"
Call Shell(strcommand, vbNormalFocus)
End If
If [A9].Value = "C" Then
sujet = "Fiche anomalie"
body = "<HTML><BODY>Bonjour" & "," & "<br>" & "<br>" & "Nous vous prions de trouver ci-joint" & ", " & _
"une fiche anomalie concernant la saisie d'un technicien de votre service." & _
" Nous vous remercions de lui transmettre ladite fiche et de lui demander de régulariser le dossier dans les meilleurs délais." & _
"<br>" & "<br>" & "<br>" & "Bien cordialement." & "<br>" & "<br>" & "<br>" & "<br>" & "Le Service Contrôle.</BODY></HTML>"
strcommand = "C:\Program Files\Mozilla Thunderbird\thunderbird"
strcommand = strcommand & " -compose " & "to='" & destinataire3 & "'"
strcommand = strcommand & "," & "cc='" & cc & "'"
strcommand = strcommand & "," & "subject='" & sujet & "',format='1',"
strcommand = strcommand & "body='" & body & "'"
strcommand = strcommand & "," & "attachment='file:///" & fichierjoint & "'"
Call Shell(strcommand, vbNormalFocus)
End If
If [A9].Value = "D" Then
sujet = "Fiche anomalie"
body = "<HTML><BODY>Bonjour" & "," & "<br>" & "<br>" & "Nous vous prions de trouver ci-joint" & ", " & _
"une fiche anomalie concernant la saisie d'un technicien de votre service." & _
" Nous vous remercions de lui transmettre ladite fiche et de lui demander de régulariser le dossier dans les meilleurs délais." & _
"<br>" & "<br>" & "<br>" & "Bien cordialement." & "<br>" & "<br>" & "<br>" & "<br>" & "Le Service Contrôle.</BODY></HTML>"
strcommand = "C:\Program Files\Mozilla Thunderbird\thunderbird"
strcommand = strcommand & " -compose " & "to='" & destinataire3 & "'"
strcommand = strcommand & "," & "cc='" & cc & "'"
strcommand = strcommand & "," & "subject='" & sujet & "',format='1',"
strcommand = strcommand & "body='" & body & "'"
strcommand = strcommand & "," & "attachment='file:///" & fichierjoint & "'"
Call Shell(strcommand, vbNormalFocus)
End If
If [A9].Value = "E" Then
sujet = "Fiche anomalie"
body = "<HTML><BODY>Bonjour" & "," & "<br>" & "<br>" & "Nous vous prions de trouver ci-joint" & ", " & _
"une fiche anomalie concernant la saisie d'un technicien de votre service." & _
" Nous vous remercions de lui transmettre ladite fiche et de lui demander de régulariser le dossier dans les meilleurs délais." & _
"<br>" & "<br>" & "<br>" & "Bien cordialement." & "<br>" & "<br>" & "<br>" & "<br>" & "Le Service Contrôle.</BODY></HTML>"
strcommand = "C:\Program Files\Mozilla Thunderbird\thunderbird"
strcommand = strcommand & " -compose " & "to='" & destinataire4 & "'"
strcommand = strcommand & "," & "cc='" & cc & "'"
strcommand = strcommand & "," & "subject='" & sujet & "',format='1',"
strcommand = strcommand & "body='" & body & "'"
strcommand = strcommand & "," & "attachment='file:///" & fichierjoint & "'"
Call Shell(strcommand, vbNormalFocus)
End If
If [A9].Value = "F" Then
sujet = "Fiche anomalie"
body = "<HTML><BODY>Bonjour" & "," & "<br>" & "<br>" & "Nous vous prions de trouver ci-joint" & ", " & _
"une fiche anomalie concernant la saisie d'un technicien de votre service." & _
" Nous vous remercions de lui transmettre ladite fiche et de lui demander de régulariser le dossier dans les meilleurs délais." & _
"<br>" & "<br>" & "<br>" & "Bien cordialement." & "<br>" & "<br>" & "<br>" & "<br>" & "Le Service Contrôle.</BODY></HTML>"
strcommand = "C:\Program Files\Mozilla Thunderbird\thunderbird"
strcommand = strcommand & " -compose " & "to='" & destinataire5 & "'"
strcommand = strcommand & "," & "cc='" & cc & "'"
strcommand = strcommand & "," & "subject='" & sujet & "',format='1',"
strcommand = strcommand & "body='" & body & "'"
strcommand = strcommand & "," & "attachment='file:///" & fichierjoint & "'"
Call Shell(strcommand, vbNormalFocus)
End If
If [A9].Value = "G" Then
sujet = "Fiche anomalie"
body = "<HTML><BODY>Bonjour" & "," & "<br>" & "<br>" & "Nous vous prions de trouver ci-joint" & ", " & _
"une fiche anomalie concernant la saisie d'un technicien de votre service." & _
" Nous vous remercions de lui transmettre ladite fiche et de lui demander de régulariser le dossier dans les meilleurs délais." & _
"<br>" & "<br>" & "<br>" & "Bien cordialement." & "<br>" & "<br>" & "<br>" & "<br>" & "Le Service Contrôle.</BODY></HTML>"
strcommand = "C:\Program Files\Mozilla Thunderbird\thunderbird"
strcommand = strcommand & " -compose " & "to='" & destinataire5 & "'"
strcommand = strcommand & "," & "cc='" & cc & "'"
strcommand = strcommand & "," & "subject='" & sujet & "',format='1',"
strcommand = strcommand & "body='" & body & "'"
strcommand = strcommand & "," & "attachment='file:///" & fichierjoint & "'"
Call Shell(strcommand, vbNormalFocus)
End If
If [A9].Value = "H" Then
sujet = "Fiche anomalie"
body = "<HTML><BODY>Bonjour" & "," & "<br>" & "<br>" & "Nous vous prions de trouver ci-joint" & ", " & _
"une fiche anomalie concernant la saisie d'un technicien de votre service." & _
" Nous vous remercions de lui transmettre ladite fiche et de lui demander de régulariser le dossier dans les meilleurs délais." & _
"<br>" & "<br>" & "<br>" & "Bien cordialement." & "<br>" & "<br>" & "<br>" & "<br>" & "Le Service Contrôle.</BODY></HTML>"
strcommand = "C:\Program Files\Mozilla Thunderbird\thunderbird"
strcommand = strcommand & " -compose " & "to='" & destinataire6 & "'"
strcommand = strcommand & "," & "cc='" & cc & "'"
strcommand = strcommand & "," & "subject='" & sujet & "',format='1',"
strcommand = strcommand & "body='" & body & "'"
strcommand = strcommand & "," & "attachment='file:///" & fichierjoint & "'"
Call Shell(strcommand, vbNormalFocus)
End If
Rep = MsgBox("Voulez-vous revenir au modèle et fermer la présente fiche anomalie ?", vbYesNo + vbQuestion, "Le programme demande votre attention")
If Rep = vbYes Then
Workbooks.Open Filename:=chemin & Fichier
Workbooks(Fichier2).Close SaveChanges:=False
End If
End Sub