Je rencontre toujours le problème sur le fichier.
Lorsque je lance la macro, j'ai un deuxième bouton qui apparait malgré vos suggestions cela ne fonctionne pas.
Bonjour,
Pour commencer, je donne très peu de potentiel de vie à ton fichier, il va un moment ou un autre être corrompu...
Comme tu peux le remarquer, "Feuil5, 7 et 9" ont le même icône que "ThisWorkbook", signe d'une défaillance proche...
Petit conseil, copie ta Feuil1 (ainsi que le module3) dans un nouveau classeur, tout neuf...
Ensuite, pour ton pb, tu peux essayer de modifier ton code ainsi : (partie Outlook non testée...)
VB:
Sub dupliquerfeuille()
Dim Nom As String
Dim Obj As Object
Nom = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ActiveWorkbook.Path & "\" & Nom, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:= _
False
Set OlApp = CreateObject("Outlook.application")
Set m = OlApp.CreateItem(0)
With m
.Attachments.Add ActiveWorkbook.Path & "\" & Nom
.Display
End With
Sheets("CR DE VISITE").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
For Each Obj In .DrawingObjects
Obj.Delete ' suppression des boutons , checkboxs..etc ...
Next Obj
.Name = Format(Date, "dd-mm-yyyy")
End With
End Sub
Dans ton ancien code, pourquoi insérais-tu un nouvel objet?
Bon courage
Je rencontre toujours le problème sur le fichier.
Lorsque je lance la macro, j'ai un deuxième bouton qui apparait malgré vos suggestions cela ne fonctionne pas.
Bonjour @Jefflet, bhbh,
J'adhère totalement au post #7 de @bhbh,
si toutefois, pour des raisons qui ne peuvent appartenir qu'à vous, vous tenez absolument à garder votre code intact, vous pouvez ajouter en fin de procédure 'dupliquerfeuille()' le code suivant :
VB:
For Each Obj In Sheets("CR DE VISITE").DrawingObjects
If Obj.Name <> "Button 4" Then Obj.Delete
Next
ce qui aura pour effet de détruire le bouton supplémentaire créé (pourquoi l'avoir créé?).
J'attire en outre votre attention sur le fait que, si le bouton de commande qui lance la macro change de nom et devient par exemple "Lancer_Macro", il sera nécessaire de remplacer dans le code "Button 4" par "LancerMacro" au risque de voir le bouton de commande originel détruit.
Cordialement,
Merci beaucoup pour votre aide et vos conseils !
Tout fonctionne parfaitement.
Ma dernière demande :
Ma feuille est protégée afin d'éviter les modifications.
Je souhaiterai ajouter ceci dans la macro mais cela ne fonctionne pas :
Merci beaucoup pour votre aide et vos conseils !
Tout fonctionne parfaitement.
Ma dernière demande :
Ma feuille est protégée afin d'éviter les modifications.
Je souhaiterai ajouter ceci dans la macro mais cela ne fonctionne pas :
Merci pour l'aide.
Je suis désolé mais pas un expert comme vous le voyez.
Pourriez-vous m'intégrer les éléments dans le code ?
Merci à vous
Sub dupliquerfeuille()
Dim Nom As String
Dim Obj As Object
Nom = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ActiveWorkbook.Path & "\" & Nom, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:= _
False
Set OlApp = CreateObject("Outlook.application")
Set m = OlApp.CreateItem(0)
With m
.Attachments.Add ActiveWorkbook.Path & "\" & Nom
.Display
End With
Sheets("CR DE VISITE").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
For Each Obj In .DrawingObjects
Obj.Delete ' suppression des boutons , checkboxs..etc ...
Next Obj
.Name = Format(Date, "dd-mm-yyyy")
End With
End Sub
Merci pour l'aide.
Je suis désolé mais pas un expert comme vous le voyez.
Pourriez-vous m'intégrer les éléments dans le code ?
Merci à vous
Sub dupliquerfeuille()
Dim Nom As String
Dim Obj As Object
Nom = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ActiveWorkbook.Path & "\" & Nom, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:= _
False
Set OlApp = CreateObject("Outlook.application")
Set m = OlApp.CreateItem(0)
With m
.Attachments.Add ActiveWorkbook.Path & "\" & Nom
.Display
End With
Sheets("CR DE VISITE").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
For Each Obj In .DrawingObjects
Obj.Delete ' suppression des boutons , checkboxs..etc ...
Next Obj
.Name = Format(Date, "dd-mm-yyyy")
End With
End Sub
Sub dupliquerfeuille()
Dim Nom As String
Dim Obj As Object
Nom = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "pdf"
ActiveSheet. UnProtect "motdepasse" 'si la feuille active est protégée
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ActiveWorkbook.Path & "\" & Nom, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:= _
False
Set OlApp = CreateObject("Outlook.application")
Set m = OlApp.CreateItem(0)
With m
.Attachments.Add ActiveWorkbook.Path & "\" & Nom
.Display
End With
Sheets("CR DE VISITE").UnProtect "motdepasse" 'si la feuille "CR DE VISITE" est protégée'
Sheets("CR DE VISITE").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
For Each Obj In .DrawingObjects
Obj.Delete ' suppression des boutons , checkboxs..etc ...
Next Obj
.Name = Format(Date, "dd-mm-yyyy")
End With
Sheets("CR DE VISITE").Protect "motdepasse"
activesheet.Protect "motdepasse"
End Sub