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
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