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: 3
Trier par date Trier par votes
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
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
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
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 </>
1671629715366.png
 
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: 3
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
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
  • Résolu(e)
XL 2021 Quand mon devis déborde sur la page 2 ?
Réponses
4
Affichages
259
patricktoulon
patricktoulon
O
  • Résolu(e)
Microsoft 365 Amélioration/réparation d'une Macro et création d'un bouton pour calcul consommation
2
Réponses
27
Affichages
582
Olihoes
O
M
  • Question
XL 2021 Colorer avec condition de temps
2
Réponses
27
Affichages
607
matlatarte
M
G
  • Question
Microsoft 365 graphique en anneau
Réponses
2
Affichages
197
gwena2b
G
F
  • Question
XL 2010 automatiser le calcul de la prime
Réponses
6
Affichages
385
TooFatBoy
TooFatBoy
T
  • Question
Microsoft 365 Bouton qui change de taille...
Réponses
3
Affichages
446
ThierryP
T
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
741
Calizarine
C
D
  • Question
XL 2021 3 problèmes : Bouton VBA (fusion et suppression) & doublons
Réponses
4
Affichages
240
Dubuyz1
D
Dudu2
  • Question
XL 2016 Excel & VBA - Sur-sélection avec Control - Comportements différents
2
Réponses
16
Affichages
484
TooFatBoy
TooFatBoy
BenHarber
  • Question
Microsoft 365 usf : insérer une images qui fait office de bouton
Réponses
2
Affichages
271
BenHarber
BenHarber

Membres actuellement en ligne

21 membres et 317 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
314 630
Messages
2 111 375
Membres
111 115
dernier inscrit
mermo