Microsoft 365 Bouton de macro qui se dupplique lors de l'execution

J

Jefflet

XLDnaute Nouveau
Bonjour,

J'ai mis en place une macro seulement lorsque je l'exécute elle me duplique le bouton sur la page.
Comment éviter ce comportement ?

Merci à vous,

Jefflet
 

Pièces jointes

  • a.xlsx
    202.7 KB · Affichages: 2
Trier par date Trier par votes
Cousinhub

Cousinhub

XLDnaute Barbatruc
Bonjour,
Bon, on n'aura pas vu ton code, mais...
Clic droit sur le bouton, "Format de contrôle"
1671627579352.png

Bonne journée
 
Vote positif 0 Vote négatif
J

Jefflet

XLDnaute Nouveau
bhbh à dit:
Bonjour,
Bon, on n'aura pas vu ton code, mais...
Clic droit sur le bouton, "Format de contrôle"
Regarde la pièce jointe 1158395
Bonne journée
Cliquez pour agrandir...
J'ai effectué la démarche sauf que quand je copie colle la feuille sur la feuille source j'ai toujours le bouton.
Le code est :

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").Select
ActiveSheet.Buttons.Add(1230, 45.75, 178.5, 86.25).Select
Sheets("CR DE VISITE").Copy After:=Sheets(2)
Columns("A:L").Select
Selection.Copy
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim Obj As Object
For Each Obj In ActiveSheet.DrawingObjects
Obj.Delete ' suppression des boutons , checkboxs..etc ...
Next Obj
ActiveSheet.Name = Format(Date, "dd-mm-yyyy")


End Sub
 
Vote positif 0 Vote négatif
J

Jefflet

XLDnaute Nouveau
bhbh à dit:
Re-,
Rajoute cette ligne à la suite du .Copy :
VB: 
Sheets("CR DE VISITE").Copy After:=Sheets(2)
ActiveSheet.Shapes("Button 1").Delete

Bien que la boucle For Each fait bien le boulot demandé....
PS, pense à mettre tes codes entre balises </>
Regarde la pièce jointe 1158401
Cliquez pour agrandir...
Désolé mais je suis novice sur le sujet. J'ai bien ajouté la ligne mais j'ai toujours la création d'un bouton supplémentaire

Sub dupliquerfeuille()
Dim Nom As String

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").Select
ActiveSheet.Buttons.Add(1230, 45.75, 178.5, 86.25).Select
Sheets("CR DE VISITE").Copy After:=Sheets(2)
ActiveSheet.Shapes("Button 1").Delete
Columns("A:L").Select
Selection.Copy
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim Obj As Object
For Each Obj In ActiveSheet.DrawingObjects
Obj.Delete ' suppression des boutons , checkboxs..etc ...
Next Obj
ActiveSheet.Name = Format(Date, "dd-mm-yyyy")
 
Vote positif 0 Vote négatif
J

Jefflet

XLDnaute Nouveau
Bonjour,

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.

Pourriez-vous m'aider ?

Merci à vous,
 

Pièces jointes

  • CR_TEST.xlsm
    34.5 KB · Affichages: 2
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Bonjour,
Pour commencer, je donne très peu de potentiel de vie à ton fichier, il va un moment ou un autre être corrompu...


jefflet.jpg

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
 
Vote positif 0 Vote négatif
Gégé-45550

Gégé-45550

XLDnaute Accro
Jefflet à dit:
Bonjour,

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.

Pourriez-vous m'aider ?

Merci à vous,
Cliquez pour agrandir...
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,
 
Dernière édition:
Vote positif 0 Vote négatif
J

Jefflet

XLDnaute Nouveau
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 :

Sub MacroavecfeuilleProtect()

ActiveSheet.Unprotect "lemotdepasse"

'Placez ici vos instructions

ActiveSheet.Protect "lemotdepasse", True, True, True

End Sub

Merci à vous
 
Vote positif 0 Vote négatif
Gégé-45550

Gégé-45550

XLDnaute Accro
Jefflet à dit:
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 :

Sub MacroavecfeuilleProtect()

ActiveSheet.Unprotect "lemotdepasse"

'Placez ici vos instructions

ActiveSheet.Protect "lemotdepasse", True, True, True

End Sub

Merci à vous
Cliquez pour agrandir...
Bonjour,
Pour que ça fonctionne, il faut que vous écriviez par exemple :
VB: 
ThisWorkBook.Worksheets("lafeuillesurlaquelleagitcettemacro").UnProtect "lebonmotdepasse"
au début de chaque procédure qui agit sur "lafeuillesurlaquelleagitcettemacro" puis
VB: 
ThisWorkBook.Worksheets("lafeuillesurlaquelleagitcettemacro").Protect "lebonmotdepasse"
à la fin de chacune de ces procédures.
Bien cordialement
 
Vote positif 0 Vote négatif
J

Jefflet

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif
Gégé-45550

Gégé-45550

XLDnaute Accro
Jefflet à dit:
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
Cliquez pour agrandir...
VB: 
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
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
XL 2021 Excel facturation avec BD clients (modèle utilisable joint) - liste déroulante =INDIRECT sur classeur séparé
Réponses
12
Affichages
433
Calizarine
C
Dudu2
  • Question
XL 2016 Excel & VBA - Sur-sélection avec Control - Comportements différents
2
Réponses
16
Affichages
206
TooFatBoy
TooFatBoy
R
  • Question
Microsoft 365 Macro masquer/Afficher des lignes avec un bouton
Réponses
8
Affichages
227
Staple1600
Staple1600
R
  • Question
XL 2019 Lancer macro etape par etape
Réponses
5
Affichages
534
Rabeto
R
L
  • Question
XL 2021 Macro qui détecte un bouton (formulaire)
Réponses
4
Affichages
236
Laetitia.B
L
J
  • Question
Microsoft 365 Problème lien hypertexte
Réponses
5
Affichages
249
Phil69970
Phil69970
L
  • Résolu(e)
Microsoft 365 Suppression de cellules vide
Réponses
3
Affichages
213
Le Rouky
L
C
  • Résolu(e)
XL 2021 Recherche et affichage de doublons
2
Réponses
26
Affichages
893
gbinforme
G
G
  • Question
XL 2021 macro supprimée
Réponses
4
Affichages
227
youky(BJ)
youky(BJ)
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Aide pour afficher et masquer
Réponses
2
Affichages
258
chaelie2015
chaelie2015

Membres actuellement en ligne

2 membres et 40 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 493
Messages
2 088 957
Membres
103 990
dernier inscrit
lamiadebz