la fonction ActiveSheet.DrawingObjects.Delete

chinel

XLDnaute Impliqué
Bonjour tout le monde !
j'ai ceci comme code:
sub copie
Workbooks.Open Filename:= _
"C:\Documents and Settings\Manuel Dejong\Mes documents\Backupdevis.xlsx"
Windows("testfactureetdevis.xlsm").Activate
Range("K17").Select
Sheets("Moddevis").Select
ActiveSheet.Buttons.Add(646.5, 382.5, 147.75, 60).Select
ActiveSheet.Buttons.Add(850.5, 129.75, 157.5, 60.75).Select

Sheets("Moddevis").Copy Before:=Workbooks("Backupdevis.xlsx").Sheets(3)
ActiveSheet.DrawingObjects.Delete
Windows("testfactureetdevis.xlsm").Activate
End Sub

mais quand je fais: ActiveSheet.DrawingObjects.Delete j'ai mon image a disparu (normal) mais comment la garder ?
merci de votre aide !
 

job75

XLDnaute Barbatruc
Re : la fonction ActiveSheet.DrawingObjects.Delete

Bonjour chinel,

Je suppose que vous voulez supprimer les boutons de la feuille active initiale.

Mémorisez-la dans une variable, au bon moment :

Code:
Dim F As Object
'-----
Set F = ActiveSheet
'-----
F.DrawingObjects.Delete
Après 5 ans sur XLD vous devriez savoir que les Select et autres Activate sont généralement inutiles en VBA.

A+
 

chinel

XLDnaute Impliqué
Re : la fonction ActiveSheet.DrawingObjects.Delete

je n'arrive pas j'ai refais un nouveau code mais cela ne fonctionne HELP ME !

Private Sub CommandButton3_Click()
Dim F As Object
Workbooks.Open Filename:="C:\Documents and Settings\Manuel Dejong\Mes documents\Backupdevis.xlsx"
ActiveWindow.ActivateNext
Set F = ActiveSheet
F.DrawingObjects.Delete
Sheets("Moddevis").Select
Sheets("Moddevis").Copy Before:=Workbooks("Backupdevis.xlsx").Sheets(1)
End Sub
 

job75

XLDnaute Barbatruc
Re : la fonction ActiveSheet.DrawingObjects.Delete

Re,

En ne sélectionnant rien on peut même se passer de la variable F :

Code:
Sub copie()
Application.ScreenUpdating = False
Workbooks.Open Filename:= _
"C:\Documents and Settings\Manuel Dejong\Mes documents\Backupdevis.xlsx"
With Workbooks("testfactureetdevis.xlsm").Sheets("Moddevis")
  .Buttons.Add 646.5, 382.5, 147.75, 60
  .Buttons.Add 850.5, 129.75, 157.5, 60.75
  .Copy Before:=Workbooks("Backupdevis.xlsx").Sheets(3)
  .DrawingObjects.Delete
  .Activate
End With
End Sub
A+
 

chinel

XLDnaute Impliqué
Re : la fonction ActiveSheet.DrawingObjects.Delete

Salut job75 mais le code que tu m'as donné à supprimer touts les boutons et images de mon feuille source "Moddevis" et à copier touts les boutons et images dans mon fichier "Backupdevis" moi c'est l'inverse que je voudrais bien, merci !
donc copier feuille "Moddevis" coller dans fichier "Backupdevis" en supprimant les boutons mais tout en conservant l'image.
 

job75

XLDnaute Barbatruc
Re : la fonction ActiveSheet.DrawingObjects.Delete

Re,

Alors créer les boutons dans la nouvelle feuille.

Et ne supprimer aucun objet :

Code:
Sub copie()
 Application.ScreenUpdating = False
 Workbooks.Open Filename:= _
 "C:\Documents and Settings\Manuel Dejong\Mes documents\Backupdevis.xlsx"
 With Workbooks("testfactureetdevis.xlsm").Sheets("Moddevis")
   .Copy Before:=Workbooks("Backupdevis.xlsx").Sheets(3)
   With Workbooks("Backupdevis.xlsx").Sheets(3)
     .Buttons.Add 646.5, 382.5, 147.75, 60
     .Buttons.Add 850.5, 129.75, 157.5, 60.75
   End With
   .Activate
 End With
 End Sub
Edit : si ça ne convient pas j'abandonne : sans fichiers joints et explications claires ça peut durer longtemps.

A+
 
Dernière édition:

chinel

XLDnaute Impliqué
Re : la fonction ActiveSheet.DrawingObjects.Delete

voici mon fichier, merci de votre aide à tous !
 

Pièces jointes

  • testfactureetdevis.xlsm
    83 KB · Affichages: 101
  • testfactureetdevis.xlsm
    83 KB · Affichages: 98
  • testfactureetdevis.xlsm
    83 KB · Affichages: 109

job75

XLDnaute Barbatruc
Re : la fonction ActiveSheet.DrawingObjects.Delete

Bonjour chinel,

Avec le fichier c'est maintenant clair :

Code:
Sub copie()
Dim s As Shape
Application.ScreenUpdating = False
Workbooks.Open Filename:= _
"C:\Documents and Settings\Manuel Dejong\Mes documents\Backupdevis.xlsx"
With ThisWorkbook.Sheets("Moddevis")
  .Copy Before:=Workbooks("Backupdevis.xlsx").Sheets(3)
  .Activate
End With
With Workbooks("Backupdevis.xlsx").Sheets(3)
  For Each s In .Shapes
    If Not s.Name Like "Picture*" Then s.Delete
  Next
  '--enregistrement et fermeture facultatifs--
  Application.DisplayAlerts = False
  .Parent.Close True
End With
End Sub
Tous les objets sont supprimés sauf l'image.

Votre fichier en retour.

A+
 

Pièces jointes

  • testfactureetdevis.xlsm
    89.7 KB · Affichages: 148
  • testfactureetdevis.xlsm
    89.7 KB · Affichages: 135
  • testfactureetdevis.xlsm
    89.7 KB · Affichages: 132

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T