XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire

Nico2978

Nico2978

XLDnaute Nouveau
Bonjour à tous,
C'est mon premier message sur le forum, je me présente brièvement. Nicolas, chargé de projets dans une laiterie, je mets un peu mon nez dans le VBA pour pouvoir automatiser certaines tâches sur excel et accompagner mon entreprise vers une "digitalisation", car beaucoup de données actuellement enregistré sur support papier.

Dans la même veine ce chantier comprend:
  • Une interface de saisie pour le remplissage et l'archivage de feuilles de non-conformités qualité
  • Une interface de création de bon de commande reliée à une base de données fournisseur & articles
Je poste ce topic afin de vous demander de l'aide svp dans le cadre d'un projet de création d'une application de gestion de données de production d'une laiterie.
Je suis assez novice en VBA et cherche à saisir des automatismes en dev

Le topic concerne une partie du projet qui est l'archivage de feuille de production journalière en pdf dans un dossier "yyyy" avec un nom de doc "ddmmyyy".

Une partie du code fonctionne, à savoir la création de dossier et l'export de fichier avec le nom souhaité. Le problème se pose au niveau des conditions pour l'archivage.

Je souhaiterais en effet procéder comme suit après pression d'un bouton "exporter

1) Vérifier l'existence du répertoire
  1. Si FAUX
    1. Créer un répertoire format yyyy et y exporter le fichier
  2. Si VRAI--> vérifier l'existence du fichier dans le répertoire
    1. Si FAUX -->Exporter le fichier du jour
    2. Si VRAI--> Demander la validation pour écraser le fichier existant
      1. Si non --> Quitter le programme
      2. Si oui--> Supprimer le ficher le fichier existant + Exporter le nouveau fichier
Je rencontre 2 problèmes:

1) Mon premier ElseIf ne prend pas en compte l'existence d'un fichier du même et en recrée un dans tous les cas

Je pensais avoir bien compris l'intérêt de l'association des fonctions len(dir( qui renvoie le chemin en chaine puis énumère le nombre de caractère de la chaine; et si pas de chaine =Néant. Mais vu le résultat j'en doute

2) J'ai du mal à gérer la msg box yes/no au niveau de la synthaxe, je me suis surement planté quelque part



Voici le code:
VB: 
Sub Archivage()
Application.ScreenUpdating = False

'Definition des variables de la feuille
Dim Prod1 As Date
Dim Prod2 As String
Dim Annee As String

Prod1 = Sheets("production").Cells(1, 2)
Prod2 = Format(Sheets("production").Cells(1, 2), "ddmmyyyy")
Annee = Year(Prod1)

'Boucle de recherche dossier
Dim x As String
Dim chemin As String
Dim Fichier As String
chemin = "Y:\LAITERIE\2-PRODUCTION\1-Productions\" & Annee
Fichier = chemin & "\" & Prod2

On Error Resume Next

x = GetAttr(chemin) And 0
If Err <> 0 Then 'créer le dossier et le fichier prod
MkDir chemin
        Sheets("Production").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=chemin & "\" & Prod2, _
        Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

ElseIf Len(Dir(Fichier)) = 0 Then 'crée le fichier prod s'il n'existe pas
        Sheets("Production").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=chemin & "\" & Prod2, _
        Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

ElseIf Len(Dir(Fichier)) > 0 Then 'contrôle box pour la décision d'écraser fiche existante ou abandon
MsgBox = vbYesNo("Voulez vous écraser la fiche de production?", "Fiche de production déjà existante")
casevbyes
Kill (chemin & "\" & Prod2)
 Sheets("Production").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=chemin & "\" & Prod2, _
        Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
casevbno
Exit Sub

End If

Application.ScreenUpdating = True

End Sub

Pour pouvoir tester le code, il faut simplement avoir une date en B1

J'espère avoir été bien clair et je reste dispo pour apporter des éclaircissements en cas de besoin.

Merci d'avance pour l'aide que vous pourrez m'apporter

Bonne journée à tous
 
Solution
F
Salut, j'ai un peu modifié ta macro. Pour ta variable Fichier il faut ajouter l'extension .pdf.
L'utilisation de MsgBox n'est pas correcte. Vois ci-dessous.

VB: 
Sub Archivage()
    Application.ScreenUpdating = False

    'Definition des variables de la feuille
    Dim Prod1 As Date
    Dim Prod2 As String
    Dim Annee As String

    Prod1 = Sheets("production").Cells(1, 2)
    Prod2 = Format(Sheets("production").Cells(1, 2), "ddmmyyyy")
    Annee = Year(Prod1)

    'Boucle de recherche dossier
    Dim x As String
    Dim chemin As String
    Dim Fichier As String
    chemin = "Y:\LAITERIE\2-PRODUCTION\1-Productions\" & Annee
    Fichier = chemin & "\" & Prod2 & ".pdf"

    On Error Resume Next

    x = GetAttr(chemin) And 0
    If Err...
Trier par date Trier par votes
F

Franc58

XLDnaute Occasionnel
Salut, j'ai un peu modifié ta macro. Pour ta variable Fichier il faut ajouter l'extension .pdf.
L'utilisation de MsgBox n'est pas correcte. Vois ci-dessous.

VB: 
Sub Archivage()
    Application.ScreenUpdating = False

    'Definition des variables de la feuille
    Dim Prod1 As Date
    Dim Prod2 As String
    Dim Annee As String

    Prod1 = Sheets("production").Cells(1, 2)
    Prod2 = Format(Sheets("production").Cells(1, 2), "ddmmyyyy")
    Annee = Year(Prod1)

    'Boucle de recherche dossier
    Dim x As String
    Dim chemin As String
    Dim Fichier As String
    chemin = "Y:\LAITERIE\2-PRODUCTION\1-Productions\" & Annee
    Fichier = chemin & "\" & Prod2 & ".pdf"

    On Error Resume Next

    x = GetAttr(chemin) And 0
    If Err <> 0 Then 'créer le dossier et le fichier prod
        MkDir chemin
        Sheets("Production").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Fichier, _
        Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    ElseIf Len(Dir(Fichier)) = 0 Then 'crée le fichier prod s'il n'existe pas
        Sheets("Production").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Fichier, _
        Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    ElseIf Len(Dir(Fichier)) > 0 Then 'contrôle box pour la décision d'écraser fiche existante ou abandon
        Dim response As VbMsgBoxResult
        response = MsgBox("Voulez vous écraser la fiche de production?", vbYesNo, "Fiche de production déjà existante")

        If response = vbYes Then
            ' Supprimer le fichier existant et exporter le nouveau fichier
            Kill Fichier
            Sheets("Production").ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Fichier, _
            Quality:=xlQualityMinimum, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
        Else
            ' Quitter le programme
            Exit Sub
        End If
    End If

    Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
Solution
Nico2978

Nico2978

XLDnaute Nouveau
Franc58 à dit:
Salut, j'ai un peu modifié ta macro. Pour ta variable Fichier il faut ajouter l'extension .pdf.
L'utilisation de MsgBox n'est pas correcte. Vois ci-dessous.

VB: 
Sub Archivage()
    Application.ScreenUpdating = False

    'Definition des variables de la feuille
    Dim Prod1 As Date
    Dim Prod2 As String
    Dim Annee As String

    Prod1 = Sheets("production").Cells(1, 2)
    Prod2 = Format(Sheets("production").Cells(1, 2), "ddmmyyyy")
    Annee = Year(Prod1)

    'Boucle de recherche dossier
    Dim x As String
    Dim chemin As String
    Dim Fichier As String
    chemin = "Y:\LAITERIE\2-PRODUCTION\1-Productions\" & Annee
    Fichier = chemin & "\" & Prod2 & ".pdf"

    On Error Resume Next

    x = GetAttr(chemin) And 0
    If Err <> 0 Then 'créer le dossier et le fichier prod
        MkDir chemin
        Sheets("Production").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Fichier, _
        Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    ElseIf Len(Dir(Fichier)) = 0 Then 'crée le fichier prod s'il n'existe pas
        Sheets("Production").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Fichier, _
        Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    ElseIf Len(Dir(Fichier)) > 0 Then 'contrôle box pour la décision d'écraser fiche existante ou abandon
        Dim response As VbMsgBoxResult
        response = MsgBox("Voulez vous écraser la fiche de production?", vbYesNo, "Fiche de production déjà existante")

        If response = vbYes Then
            ' Supprimer le fichier existant et exporter le nouveau fichier
            Kill Fichier
            Sheets("Production").ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Fichier, _
            Quality:=xlQualityMinimum, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
        Else
            ' Quitter le programme
            Exit Sub
        End If
    End If

    Application.ScreenUpdating = True
End Sub
Cliquez pour agrandir...
Bonjour Franck, merci mille fois pour ton aide qui résout complétement mon problème!
J'ai appris au passage qu'il faut nommer et dimensionner la variable correspondant à la msgbox yes/no, super 👌

Bon weekend
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
XL 2013 VBA enregistrement fichier dans un dossier en particulier
Réponses
3
Affichages
312
MarineU
M
N
  • Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
307
Phil69970
Phil69970
J
  • Résolu(e)
XL 2021 plantage lors d'un export format PDF
Réponses
14
Affichages
781
JPaul78
J
C
  • Résolu(e)
XL 2021 Ne pas enregistrer la 2 ème feuille dans le pdf
Réponses
1
Affichages
337
Claudinedu13
C
P
  • Question
XL 2019 Changer nom d'export en VBA
Réponses
3
Affichages
483
job75
job75
spherestyle
  • Résolu(e)
XL pour MAC Excel vba export pdf sur bureau pour Mac
Réponses
10
Affichages
1 K
Dan
Dan
M
  • Question
Microsoft 365 pb enregistrement PDF de plusieurs feuilles d'un classeur excel
2
Réponses
15
Affichages
1 K
MG_000
M
V
  • Résolu(e)
XL 2016 Exportation au format PDF à l'aide d'une macro : erreur 1004 'Document non enregistré'
Réponses
14
Affichages
942
Phil69970
Phil69970
P
  • Résolu(e)
XL 2010 Enregistrer sous un seul PDF toutes les feuilles visibles d'un classeur
Réponses
3
Affichages
698
Panda79360
P
P
  • Résolu(e)
Microsoft 365 creer un dossier et sauvergarder un fichier PDF avec le meme nom
Réponses
5
Affichages
609
Lolote83
L

Membres actuellement en ligne

2 membres et 40 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 087
Messages
2 116 082
Membres
112 654
dernier inscrit
SADIKA