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

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

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
 

Nico2978

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

Discussions similaires

Réponses
2
Affichages
345

Statistiques des forums

Discussions
312 938
Messages
2 093 784
Membres
105 830
dernier inscrit
sylvain.marteel1-partner@