Exécution Automatique Résolu

Question

Bonjour à tous,

Voilà, je ne suis pas un expert dans la programmation VBA puisque je viens de m'y mettre pour un projet en entreprise que je dois effectuer.

Mais j'ai un soucis dont je n'arrive pas a me débarrasser et qui me pose un réel problème après plusieurs recherches infructueuses auprès de notre ami Google.

Explication de mon problème :
L'entreprise utilise le logiciel Excel afin de créer / gérer les fiches des clients (Entreprise Informatique, ici l'utilisation du logiciel est pour le côté technique de réparation de PC). Ils m'ont demandé d'améliorer leur logiciel afin de répondre à leurs nouveaux besoins. Chose que j'ai développé avec plus ou moins de réussite. Attaquons le vif du sujet si vous le voulez bien.
J'aimerais lier des macros personnelles à l'objet ThisWorkbook grâce aux fonctionnalités proposé par celui-ci.
Notamment que le fichier s'enregistre dans un dossier X lors de l'impression (CTRL + P ou fichier -> Imprimer). Mais cela ne fonctionne pas, en effet l'action enregistrer se déroule bien, mais il l'enregistre sur le classeur "vierge".
Je souhaite que lors de l'impression (BeforePrint) le fichier se sauvegarde avec les données que j'ai codé dans le dossier X.

J'espère avoir été claire sur ma question, sinon j'essayerais de revenir dessus afin d'être plus explicite. Je vous laisse mon code, afin que vous ayez peut-être un meilleur aperçu de mon problème.

Objet ThisWorkbook :
Private Sub Workbook_BeforePrint(Cancel As Boolean)

    enregistrer

   End Sub
 

Macro enregistrer
Public Sub enregistrer()
 
    'Arrête provisoirement la mise à jour de l'écran (Temps d'exécution largement augmenté)
    Application.ScreenUpdating = False
   
    'Définir les Variables des noms de repertoire de sauvegarde
    Dim Fichier As String
    Dim Repertoire As String
    
    'Définir les Variables
    Repertoire = "C:\Users\Admin\...\En attente\" 'J'ai volontairement supprimé une partie du chemin.

    'Cherche le nom du client pour le stocker dans Fichier (Sous forme de "NomClient TypeDossier Date.xls")
    Sheets("PC").Select
    'Test dans la feuille PC
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
    Sheets("PORTABLE").Select
    'Test dans la feuille PORTABLE
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
    Sheets("IMPRIMANTE").Select
    'Test dans la feuille IMPRIMANTE
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
    Sheets("SAV").Select
    'Test dans la feuille SAV
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
    Sheets("Devis").Select
    'Test dans la feuille Devis
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If

    'Si le nom est le même alors ne pas faire la manipulation Fonction enregistrer
    If ThisWorkbook.Name = Fichier Then Exit Sub
    
    'Sauvegarde le fichier sous son propre nom
    ThisWorkbook.Save
    
    'Enregistre le Fichier
    ActiveWorkbook.SaveAs Filename:=Repertoire & Fichier

    'Renvois automatiquement sur la feuille Présentation
    Sheets("Présentation").Select

    'Réactive la mise à jour automatique de l'écran
    Application.ScreenUpdating = True

End Sub

Le code est volontairement commenté, car on m'a appris à toujours le faire ainsi afin que si je dois reprendre le code plus tard je sache quelle fonction fait quoi. Et si un autre programmeur doit passer après mon code, qu'il ne passe pas 3 heures a le déchiffrer.

f894009 · Answer

Bonjour,

quel excel avez vous ????

 les données que j'ai codé dans le dossier X. valeurs dans cellules ou macros ?????

Debutant_VBA · Answer

J'utilise actuellement Excel 2013.

Le code que j'ai fourni est dans l'éditeur VBA. Donc par macros.

f894009 · Answer

Re,

votre phrase:
Je souhaite que lors de l'impression (BeforePrint) le fichier se sauvegarde avec les données que j'ai codé dans le dossier X. 

ma question: valeurs dans cellules ou macros ?????

Debutant_VBA · Answer

On a du mal a se comprendre on dirait.

Je souhaiterais que la macro Sub enregistrer ()  soit appelée quand je lance l'impression de mon document (BeforePrint)

Pour plus de précision :
Dans le classeur excel qu'ils ont, il y a plusieurs feuilles (PC, PORTABLE, IMPRIMANTE, Devis, SAV). Dans ma macro enregistrer, je cherche comme indiqué dans le code la première cellule B1 qui ne serait pas vide afin d'enregistrer le document avec le texte contenu dans cette cellule (nom du client), j'y met également le chemin où le fichier doit être enregistré ainsi qu'un format spécial. Mais cette partie fonctionne (le fichier porte bien le nom et le format souhaité).
Mon problème c'est que dans beforeprint j'ai l'impression que cela n'appelle pas ma macro, ou que son exécution se fait mal. Car une fois le lancement de l'impression il me demande si je souhaite enregistrer les modifications apportées sur mon fichier excel se nommant "sauvegarde pure.xls". Donc d'après ma conclusion c'est que dans la méthode BeforePrint ma macro n'est pas appelée puisque le ficher devrait être enregistré dans mon dossier "\en attente\" avec comme nom "NomClient TypeDossier date.xls"
Avec TypeDossier = PC FIXE ou PORTABLE (etc ...)
Date = date de création de la fiche (généralement la date courante)

J'espère avoir répondu a votre question.

Debutant_VBA · Answer

up

f894009 · Answer

Bonjour,

Mettez un point d'arret dans votre macro pour verifier si le code s'execute.

Debutant_VBA · Answer

Je l'ai fais, tout se déroule correctement, voilà pourquoi je ne sais pas trop d'où cela peut venir...

f894009 · Answer

Re,

cela est pour le fichier ou vous lancez la macro
    'Sauvegarde le fichier sous son propre nom
    ThisWorkbook.Save
    
cela est pour le meme fichier avec un nom different
    'Enregistre le Fichier
    ActiveWorkbook.SaveAs Filename:=Repertoire & Fichier

donc il n'y a pas de probleme, si excel vous demande  si vous souhaitez enregistrer les modifications apportées sur mon fichier excel se nommant "sauvegarde pure.xls",
c'est qu'il a vu un changement. Si vous ne voulez pas avoir cette demande ajoutez:

Application.DisplayAlert=False
avant
ThisWorkbook.Save
et remettre a true apres

A+

Debutant_VBA · Answer

Bonjour,

J'ai essayé votre réponse.

Malheureusement cela ne fonctionne toujours pas. Il souhaite toujours enregistrer sur "Sauvegarde pure.xls".

Alors que je souhaiterais que, lorsque ce classeur "Sauvegarde pure.xls" est ouvert et modifier pour créer une nouvelle fiche Client il laisse le classeur "Sauvegarde pure.xls" vierge, mais crée un fichier du nom du client récupéré en cellule B1 en parcourant les différentes feuilles. D'où le fait que je lançais grâce a ce bout de programme une recherche du nom de Client :
   'Cherche le nom du client pour le stocker dans Fichier (Sous forme de "NomClient TypeDossier Date.xls")
    Sheets("PC").Select
    'Test dans la feuille PC
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
    Sheets("PORTABLE").Select
    'Test dans la feuille PORTABLE
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
    Sheets("IMPRIMANTE").Select
    'Test dans la feuille IMPRIMANTE
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
    Sheets("SAV").Select
    'Test dans la feuille SAV
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
    Sheets("Devis").Select
    'Test dans la feuille Devis
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
Ce bout de code parcours l'ensemble des feuilles pour trouver le Nom du client qui est toujours en cellule B1.
J'ai même essayé d'introduire mon code dans le slot private de ThisWorkBook comme cela :
Private Sub Workbook_BeforePrint(Cancel As Boolean)
   
    'Définir les Variables des noms de repertoire de sauvegarde
    Dim Fichier As String
    Dim Repertoire As String
    
    'Définir les Variables
    Repertoire = "C:\Users\Admin\Desktop\...\En attente\"

    'Cherche le nom du client pour le stocker dans Fichier (Sous forme de "NomClient TypeDossier Date.xls")
    Sheets("PC").Select
    'Test dans la feuille PC
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
    Sheets("PORTABLE").Select
    'Test dans la feuille PORTABLE
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
    Sheets("IMPRIMANTE").Select
    'Test dans la feuille IMPRIMANTE
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
    Sheets("SAV").Select
    'Test dans la feuille SAV
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
    Sheets("Devis").Select
    'Test dans la feuille Devis
    If Not IsEmpty(Range("B1")) Then
        Fichier = Range("B1") & " " & Range("I1") & " " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    End If
   
   'Si le nom est le même alors ne pas faire la manipulation Fonction enregistrer
    If ThisWorkbook.Name = Fichier Then Exit Sub
    
    'Réactive les messages d'alertes
    Application.DisplayAlert = False
    
    'Sauvegarde le fichier sous son propre nom
    ThisWorkbook.Save
        
    'Enregistre le Fichier
    ThisWorkbook.SaveAs Filename:=Repertoire & Fichier

    'Renvois automatiquement sur la feuille Présentation
    Sheets("Présentation").Select

    'Réactive les messages d'alertes
    Application.DisplayAlert = True

End Sub
Mais rien a faire, il enregistre toujours sous le nom "Sauvegarde pure.xls". Il ne crée pas un nouveau fichier excel dans le répertoire indiqué. Pourtant lors de son exécution par association de la macro à un bouton cela fonctionne parfaitement.

Je pense que la corde au bout de l'arbre me tend les bras.

f894009 · Answer

Bonjour,

pour moi, ca marche, j'ai bien deux fichiers: celui qui sert a creer le deuxieme et le deuxieme avec le nom cree par programme!!!!

Debutant_VBA · Answer

Et bien je suis un boulet, je vais ressayé cette après-midi.
Je vous tiens au courant.

Debutant_VBA · Answer

Rebonjour f894009,

Et bien ça marche niquel. Je suis seulement un gros boulet, puisque mon imprimante était débranchée ... Donc forcément le fichier ne se sauvegardait pas correctement ...

Un grand merci à toi pour ton aide qui m'a tout de même aidé!

f894009 · Answer

Re,

Toujours la faute du mato!!!!

Si vous avez encore des test a faire pour cette appli excel ou pour d'autre ou vous avez en final des impressions, installez pdfcreator (c'est gratuit). Vous pourrez "imprimer" en fichier pdf donc pas de papier gache.

Bonne suite

Debutant_VBA · Answer

Oui j'ai installé une imprimante virtuelle pour mes tests, qui d'ailleurs fonctionne a la perfection ...

Et oui le matériel, c'est tellement bête qu'on y pense pas forcément ...

En tout cas un grand merci car avec les informations que vous m'avez donnés j'ai simplifié mon code afin que le fichier sous moins "lourd".

Exécution Automatique

14 réponses

Newsletters