Copier Coller y compris des objets

[lodam]

Bonjour à toutes et à tous
Je suis en train de réaliser un programme de devis - facturation.
Je crée une devis ;quand on clique sur 'valider' :
a) je copie toutes les données de la feuille "DEVIS"
b) j'ouvre une nouvelle feuille dans un nouveau classeur
c) je colle les valeurs et les formats
d) je dois colles les objets (c'est là que ça coince : c'est un logo et une ligne dessinée)
e) j'enregistre et ferme la nouvelle feuille

J'utilise la macro ci dessous qui est déclenchée par un bouton "valider".
le problème est dans le copier / coller ; j'ai essayé en nommant les classeurs mais j'avoue que ça ne marche pas.

Auriez vous une idée ?

Merci pour votre aide

*************
Sub enregistrer()

Dim wshFeuille As Worksheet
Dim wbkBook, nouvo_wbkBook As Workbook

Application.ScreenUpdating = False
Set wbkBook = ActiveWorkbook

NomRep = Sheets("form").Range("chemin_devis")
NomArchive = Sheets("devis").Range("nom_client") & "_" & Sheets("devis").Range("code_devis")


'dans un 1er temps Copie de devis
Sheets("devis").Select
Range("A1:O63").Copy
'Shapes("Objet9").Copy

' coller dans une nouvelle feuille qui sera la sauvegarde de ce devis
Application.Workbooks.Add

' identifier le nouveau classeur et coller toutes les valeurs et les mises en forme
Set nouvo_wbkBook = ActiveWorkbook

With Worksheets("feuil1").Range("a1")
.PasteSpecial Paste:=xlPasteValidation
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
.PasteSpecial Paste:=xlPasteColumnWidths
End With

ActiveSheet.PageSetup.PrintArea = "$A$1:$O$63"
With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With

'dans 2e temps, copie des objets
wbkBook.Select ' =========> ET C'EST La QUE SE POSE LE PROBLEME
Sheets("devis").Shapes("Objet9").Copy
nouvo_wbkBook.Select
Shapes("Objet9").Paste

'Ontermine la mise en forme de la nouvelle feuille sauvegardée et on l'enregistre
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayZeros = False
Sheets(Array("Feuil3", "Feuil2")).Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete

Nomfichier = NomRep & NomArchive

ActiveWorkbook.SaveAs Nomfichier

ActiveWorkbook.Close


'on fait apparaitre à nouveau les modif à l'écran
Application.ScreenUpdating = True

End Sub

 

[Staple1600]

Re : Copier Coller y compris des objets

Bonjour


Si tu copies la feuille (cela inclue les objets, non?)

Sub Macro1()
'à titre d'exemple
Sheets("DEVIS").Copy After:=Sheets(3)
End Sub

En utilsant l'enregistreur de macro (et après quelques essais et modifications du code)

Sub Macro4()
Application.ScreenUpdating = False
Workbooks.Add
'ici mettre ton code pour le chemin et nom du fichier
ActiveWorkbook.SaveAs Filename:="C:\letest.xls", FileFormat:=xlNormal
Windows("xtest.xls").Activate
Sheets("Feuil1").Copy Before:=Sheets(1)
    With ActiveSheet
        .Name = "copiedevis"
        .Move Before:=Workbooks("letest.xls").Sheets(1)
    End With
    Application.DisplayAlerts = False
    With ActiveWorkbook
        .Sheets("Feuil1").Delete
        .Save
        .Close
    End With
End Sub

Dans le classeur d'origine, il y avait une forme automatique, des valeurs dans des cellules
Tout a bien été copié dans le nouveau classeur.

 

[lodam]

Re : Copier Coller y compris des objets

Bonjour
merci pour ta réponse
effectivement, cela copie toute la feuille
mais j'ai des boutons de commande, des listes de validations, des formules, des liaisons..
Donc ce que je souhaiterais faire c'est copier toute la feuille "devis" et coller dans un autre classeur
-les valeurs (ça c'est ok)
-la mise en forme (ça c'est ok)
-les objets : logos par exemple : ça c'est pas bon...

merci encore pour ton aide
je continue à chercher
voici en pj un fichier exemple

 

[lodam]

bonjour ,

ça avance pas beaucoup mon histoire
J'en suis toujours à essayer de coller mon logo et ça ne fonctionne toujours pas.
Pourriez-vous m'aiguiler ?
merci d'avance
j'en suis là :

--------------------------

Private Sub CommandButton2_Click()
Dim WkClasseur As Workbook, WkFinal As Workbook

Set WkClasseur = Workbooks("exdevis.xls")
'*****************
'Dans un 1er temps on Copie le devis
Sheets("devis").Select
Range("A1:O63").Copy

'on crée un nouveau classeur
Set WkFinal = Workbooks.Add

'on y colle les données du devis
With Worksheets("feuil1").Range("a1")
.PasteSpecial Paste:=xlPasteValidation
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
.PasteSpecial Paste:=xlPasteColumnWidths
End With

'*****************
'Dans un deuxième temps, on copie les objets : le logo
'on revient sur le devis pour copier l'objet
Workbooks("exdevis.xls").Worksheets("devis").Activate
Shapes("Objet9").Copy

'on active le deuxième classeur pour y coller l'objet
WkFinal.Activate
Sheets("feuil1").Select
Shapes("Objet9").Paste ' ça ne marche pas



End Sub

 

[Staple1600]

Re : Copier Coller y compris des objets

Bonjour



Pourquoi ne pas utiliser cette méthode

Private Sub CommandButton2_Click()
Dim WkClasseur As Workbook, WkFinal As Workbook

[B]Dim LeLogo As String
LeLogo = "C:\images\logo.jpg"[/B]

Set WkClasseur = Workbooks("exdevis.xls")
'*****************
'Dans un 1er temps on Copie le devis
Sheets("devis").Range("A1:O63").Copy

'on crée un nouveau classeur
Set WkFinal = Workbooks.Add

'on y colle les données du devis
With Worksheets("feuil1").Range("a1")
.PasteSpecial Paste:=xlPasteValidation
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlFormats
.PasteSpecial Paste:=xlPasteColumnWidths
End With

'*****************

'Insertion du logo
WkFinal.Activate
[B]Sheets("feuil1").Pictures.Insert LeLogo
[/B]' a tester
'WkFinal.Sheets("feuil1").Pictures.Insert LeLogo
End Sub

 

[lodam]

Re : Copier Coller y compris des objets

ah oui, c'est intéressant comme méthode
je vais essayer ceci et je te tiens au courant

merci

 

[lodam]

Re : Copier Coller y compris des objets

Oui effectivement ça marche bien
Mais la position est à modifier car le logo est inséré au dessus de la cellule A1 par défaut je pense

Par ailleurs, j'ai d'autres éléments à coller comme des formes et des dessins qui ne sont pas des images et qui ne peuvent donc pas être insérés comme un fichier mais bel et bien par un copier coller (qui garde la position soit dit en passant)

donc cette solution m'a fait avancé mais je ne suis pas encore arrivé
merci beaucoup de ton aide
lodam

 

[Staple1600]

Re : Copier Coller y compris des objets

Re
edit:
Il semblerait qu'il faille utiliser Shapes Range

Sub retest()
ActiveSheet.Shapes.Range(Array("Rectangle 1", "Ellipse 2")).Select
'ici mettre le noms de tes formes à copier dans Array(
Selection.Copy
Sheets("Feuil3").Select
ActiveSheet.Paste
End Sub

Ceci fonctionne (code genéré par l'enregistreur de macro)
(avec Excel 2000)

Sub Macro6()
ActiveSheet.DrawingObjects.Select
Selection.Copy
Windows("test.xls").Activate
Range("A1").Select
ActiveSheet.PasteSpecial Format:="Objet dessiné MS Office", Link:=False, _
DisplayAsIcon:=False
End Sub

 

[lodam]

Re : Copier Coller y compris des objets

ah oui
je vais essayer ceci même si j'ai excel 2003
merci encore
à plus tard
lodam

 

[lodam]

Re : Copier Coller y compris des objets

il semblerait que cela marche bien
je vais l'intégrer dans mon fichier final et créer le tableau ARRAY et je te tiens au courant