Aide Macro recherché

[wilbur11]

Bonjour à tous,

Étant assez débutant avec les macros, je ne comprends pas tout les subtilités du langage.
J’ai par contre réussi à faire ma macro.
Il me reste quelque bogue que j’essaye de régler 1 par 1 dont celui-ci.

Mon fichier étant trop gros pour être en PJ même en .ZIP, je mets donc ma macro.

J’ai de la misère avec le pastespecial dans la première partie de la macro. Lorsque j’exécute la macro il me donne une erreur du type : erreur d’exécution 1004. erreur défini par l’application pour la l’objet.

Si quelqu’un pouvait m’aider…

Sub essai()
Dim Nomfichier As String, chemin As String
ActiveSheet.Unprotect
With Sheets("Soumission client")
.Activate
.Copy
Nomfichier = "Soumission_" & Range("a4") & "_" & Range("b8")
ActiveSheet.UsedRange
.Copy
.PasteSpecial Paste:=xlValues

End With

'répertoire de sauvegarde
chemin = "D:\Mes documents\ebenisterie\soumission\"


ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
'on définit le nom du futur fichier et son extension en tant que fichier xls
ActiveWorkbook.SaveAs Filename:=chemin & Nomfichier & ".xls"
Sheets("Soumission client").Name = Nomfichier

'là un petit message pour faire joli et indiquer que la sauvegarde a bien été exécutée
msg = "Votre Facture a été sauvegardée sous le nom et n° que vous lui avez donné."
Title = "Sauvegarde de la facture actuelle"
Style = vbOKOnly + vbInformation
Reponse = MsgBox(msg, Style, Title)

ActiveSheet.Protect
ActiveWorkbook.Close (False)

'sur le fichier d'origine on incrémente la cellule a7 de 1 et on efface les cellules
Sheets("Soumission client").Range("a4") = Range("a4") + 1
Sheets("devis").Range("b2:b5") = ""
Sheets("devis").Range("b7:b8") = ""
Sheets("devis").Range("b10") = "non"
Sheets("devis").Range("f14:s15") = ""
Sheets("devis").Range("c14:c14") = ""
Sheets("devis").Range("b17:b17") = ""

'on reprotège la feuille
ActiveSheet.Protect
End Sub

 

[tototiti2008]

Re : Aide Macro recherché

Bonjour wilbur,

Peux-tu nous décrire l'ensemble des opérations que doit réaliser ta macro ?
Le plus simple serait de commenter ton code (et de le reposter avec la balise code #) pour expliquer ce qu'est censé réaliser chaque partie.
Pour être franc, je ne comprend pas ce que la partie

With Sheets("Soumission client")
    .Activate
    .Copy
    Nomfichier = "Soumission_" & Range("a4") & "_" & Range("b8")
    ActiveSheet.UsedRange
    .Copy
    .PasteSpecial Paste:=xlValues
   
End With

est censée faire

 

[Efgé]

Re : Aide Macro recherché

Bonjour wilbur11, tototiti ,
Après consultation des rûnes magiques par le chaman du vilage, une proposition:

Sub essai_2()
Dim Nomfichier As String, chemin As String
Application.ScreenUpdating = False
ActiveSheet.Unprotect
chemin = "D:\Mes documents\ebenisterie\soumission\"
Sheets("Soumission client").Copy
With ActiveWorkbook
    With .Sheets("Soumission client")
        Nomfichier = "Soumission_" & .Range("a4") & "_" & .Range("b8")
        .UsedRange.Copy
        .Cells(1, 1).PasteSpecial Paste:=xlValues
        .PrintOut Copies:=1, Collate:=True
        .Name = Nomfichier
        .Protect
    End With
    .SaveAs Filename:=chemin & Nomfichier & ".xls"
    .Close (False)
End With
'là un petit message pour faire joli et indiquer que la sauvegarde a bien été exécutée
msg = "Votre Facture a été sauvegardée sous le nom et n° que vous lui avez donné."
Title = "Sauvegarde de la facture actuelle"
Style = vbOKOnly + vbInformation
Reponse = MsgBox(msg, Style, Title)
'sur le fichier d'origine on incrémente la cellule a7 de 1 et on efface les cellules
Sheets("Soumission client").Range("a4") = Range("a4") + 1
With Sheets("devis")
    .Range("b2:b5,b7:b8,c14,b17,f14:s15").ClearContents
    .Range("b10") = "non"
End With
'on reprotège la feuille
ActiveSheet.Protect
Application.ScreenUpdating = False
End Sub

Cordialement

 

[wilbur11]

Re : Aide Macro recherché

Merci de prendre du temps pour moi.

Premierement j'ai reussi a zipper mon fichier (j'ai aucune idée pourquoi ca plantait toujours mais la j'ai reussi) Donc voici mon fichier.

Le but de ma macro est de prendre mon onglet "soumission client" et de la copier dans un nouveau fichier que je vais sauvegarder sous le nom = "Soumission_" & Range("a4") & "_" & Range("b8")
ensuite d'imprimer une copie de la soumission
ensuite sur le fichier original j'efface les cellules
pour terminer j'incremente le numero de soumission du fichier original et je sauvegarde le fichier original

Esperant avoir été plus claire.

Sub essai()
Dim Nomfichier As String, chemin As String
ActiveSheet.Unprotect
With Sheets("Soumission client")
.Activate
.Copy
Nomfichier = "Soumission_" & Range("a4") & "_" & Range("b8")
ActiveSheet.UsedRange
.Copy
.PasteSpecial Paste:=xlValues

End With

'répertoire de sauvegarde
chemin = "D:\Mes documents\ebenisterie\soumission\"


ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
'on définit le nom du futur fichier et son extension en tant que fichier xls
ActiveWorkbook.SaveAs Filename:=chemin & Nomfichier & ".xls"
Sheets("Soumission client").Name = Nomfichier

'là un petit message pour faire joli et indiquer que la sauvegarde a bien été exécutée
msg = "Votre Facture a été sauvegardée sous le nom et n° que vous lui avez donné."
Title = "Sauvegarde de la facture actuelle"
Style = vbOKOnly + vbInformation
Reponse = MsgBox(msg, Style, Title)

ActiveSheet.Protect
ActiveWorkbook.Close (False)

'sur le fichier d'origine on incrémente la cellule a7 de 1 et on efface les cellules
Sheets("Soumission client").Range("a4") = Range("a4") + 1
Sheets("devis").Range("b2:b5") = ""
Sheets("devis").Range("b7:b8") = ""
Sheets("devis").Range("b10") = "non"
Sheets("devis").Range("f14:s15") = ""
Sheets("devis").Range("c14:c14") = ""
Sheets("devis").Range("b17:b17") = ""

'on reprotège la feuille
ActiveSheet.Protect
End Sub

 

[Efgé]

Re : Aide Macro recherché

Re
wilbur11 , a tu essaiyé ma proposition ?
Cordialement

 

[wilbur11]

Re : Aide Macro recherché

Tototiti, Efgé, bonjour,

Effectivement Efgé tu as vu juste.

Par contre pour une raison que je ne m'explique pas encore ton code remanié plante a la fin soit apres l'incémentation du fichier. Il ne parviens pas à effacer les cellules. Pourtant tout me semble correct.

Avec le fichier que J'ai mis en PJ tantot aurais-tu la gentillesse de regarder le tout.

Merci!

 

[Efgé]

Re : Aide Macro recherché

Re
Une modif et une remarque sur la fin du code en défaut:

'On ne peux incrémenter un texte (Soumission 248)
'Sheets("Soumission client").Range("a4") = Range("a4") + 1
With Sheets("devis")
    .Range("b2:b5,b7:b8,c14,b17,f14:s15") = ""
    .Range("b10") = "non"
End With

Cordialement

 

[wilbur11]

Re : Aide Macro recherché

Merci infiniment Efgé.

Tout est rentré dans l'ordre.

A titre d'info. personnel, oui je peux incrémenter le numéro de soumission car si tu regarde dans la celule a4, tu vas voir que seul le numéro est inscrit. le mot soumission apparait par le format utilisé. J'ai fais l'ajustement sur la formule pour reactiver le tout et ca marche au poil.

Merci encore.