XL 2019 Vérifier si Fichier PDF existe dans sauvegarde

AIXELS

AIXELS

XLDnaute Occasionnel
Bonjour à tous les Amis du Forum. :)
Grâce à votre aide et vos compétences, j'avance sur mon projet.
Je reviens vers vous une fois de plus de l'aide concernant
le contrôle de la présence du fichier archivé sous format PDF.
La vérification est à faire uniquement sur le numéro "D2022-09-158"
pas sur les infos qui suivent le nom de l'archive. Ce numéro évolue
dans le temps bien sûr au fur et à mesure de la la création des devis
S'il n'existe pas, on l'archive et s'il existe, un message s'affiche
"Fichier déjà existant dans l'archivage, voulez-vous l'écraser ?"
Voir les explications sur le fichier joint.
J'ai déjà commencé à le sauvegarder en PDF, mais je ne sais pas
comment faire la vérification. (Voir la macro qui fonctionne très bien)
Merci pour votre aide.
Bien cordialement.
 

Pièces jointes

  • VERIF_DEVIS.xlsm
    41.2 KB · Affichages: 6
Trier par date Trier par votes
AIXELS

AIXELS

XLDnaute Occasionnel
Bonjour @TooFatBoy
J'ai repris ton code pour sauvegarder en PDF
et ça résolu le problème en faisant un copier coller de
ton code ;

VB: 
  .ExportAsFixedFormat Type:=xlTypePDF, Filename:=CheminFichier & NomFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False

Je n'ai pas changé le chemin.
Bien cordialement.
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Bon, en fait je ne vois pas comment envoyer un SendKeys après l'ouverture et avant la fermeture de la MessageBox, donc je ne vois pas comment mettre le bouton "Non" par défaut. :(

Je poste toutefois la macro légèrement modifiée pour intégrer le vbInformation :
VB: 
Sub Sauvegarde_PDF()
' Sauvegarder devis en format PDF (n° devis + date + type + immatriculation)
Dim CheminFichier$, NomFichier$

    ' Chemin fichier déclaré en variable
    CheminFichier = "C:\XXX\SAUVEGARDES\DEVIS\"
CheminFichier = "D:\M_Detailing\Sauvegardes\Devis\"

    With Sheets("DEVIS")

        ' On crée le nom du fichier de sauvegarde (n° devis + date + type + immatriculation)
        NomFichier = .Range("B7") & " " & Format(Now, "dd-mmm-yyyy") & "  " & .Range("E7") & "  " & .Range("F7") & ".pdf"

        MaRep = vbYes

        If FichierExiste(CheminFichier & NomFichier) Then MaRep = MsgBox(NomFichier & vbCrLf & vbCrLf & "existe déjà dans le dossier" & vbCrLf & CheminFichier & vbCrLf & vbCrLf & vbCrLf & Space(42) & "Écraser le fichier existant ?", vbYesNo + vbInformation, "Sauvegarde devis")

        If MaRep = vbYes Then .ExportAsFixedFormat Type:=xlTypePDF, Filename:=CheminFichier & NomFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False

    End With

End Sub

Function FichierExiste(Fichier As String)
' Renvoie True si le fichier existe, False s'il n'existe pas

    On Error GoTo Fin

    FichierExiste = (Fichier <> "" And Len(Dir(Fichier)) > 0)
    Exit Function

Fin:
    FichierExiste = CVErr(xlErrRef)

End Function
 
Vote positif 0 Vote négatif
AIXELS

AIXELS

XLDnaute Occasionnel
Bonjour @TooFatBoy et tous les Amis du Forum. :)
Un exemple que j'ai trouvé mais que je n'ai pas réussi
reproduire pour le Non par défaut :

VB: 
Sub Reinitialiser_Devis()
    '
    Sheets("DEVIS").Select
    
    Select Case MsgBox(Buttons:=vbOKCancel + vbDefaultButton2 + vbCritical, Prompt:="   Etes vous sûr de réinitialiser les données du Devis ?" & vbNewLine & _
                                                                                     "         Toutes les données saisies seront effacées", Title:="ATTENTION !")
    Case vbOK
    
        Range("C7:F8").Select
        Selection.ClearContents
        Range("A11:A18").Select
        Selection.ClearContents
        Range("B7:B8").Select
        Range("E21").Select
        Selection.ClearContents
        Range("F11:F18").Select
        Selection.ClearContents
        Range("C7:C8").Select
        
        Select Case MsgBox(Buttons:=vbOKCancel + vbDefaultButton2 + vbQuestion, Prompt:=" Voulez-vous incrémenter" & vbNewLine & _
                                                                                         " le numéro de Devis ?", Title:="Attention !")
        Case vbOK
      
            'Incrémenter N° du Devis
            On Error Resume Next

            Sheets("DEVIS").Select
            Range("B7:B8").Select

            If MsgBox("     Valider l'incrémentation ?", 36, "Confirmation") = vbYes Then

                part1 = Year(Date)
                Part2 = Format(Month(Date), "00")
                part3 = Right(Range("L11"), 3)

                'Incrémentation N° DE DEVIS
        
                Range("L11") = "F" & part1 & "-" & Part2 & "-" & Format(Int(part3) + 1, "000")

                Range("B7") = Range("L11")
                
                Sheets("DEVIS").Range("C7") = CDate(Date)
                
                MsgBox Buttons:=vbInformation, Prompt:="    L'incrémentation du N° de Devis " & Sheets("DEVIS").[B7] & vbNewLine & _
                                                                                                                         "                     s'est déroulé avec succès !", Title:="Info"
            End If
      
        Case vbCancel
            GoTo HandleExit
        End Select
    
    Case vbCancel
        GoTo HandleExit

    End Select

HandleExit:

End Sub

Merci pour ton aide.
Bien cordialement.
 

Pièces jointes

  • Bouton Annuler par défaut.jpg
    Bouton Annuler par défaut.jpg
    22.8 KB · Affichages: 21
Vote positif 0 Vote négatif
AIXELS

AIXELS

XLDnaute Occasionnel
C'est pour cette action , le bouton Oui est activé par défaut.
Pour éviter d'écraser le fichier par inattention, que le bouton
soit actif.

VB: 
Private Sub CommandButton4_Click()

' ARCHIVER le devis en cours en format PDF (n° devis + date + type + immatriculation)
' Pour rédition duplicata, recherches,garder un historique
Dim CheminFichier$, NomFichier$

    ' Chemin fichier déclaré en variable
    CheminFichier = "C:\XXX\SAUVEGARDES\DEVIS\"

    With Sheets("DEVIS")

        ' On crée le nom du fichier de sauvegarde (n° devis + date + type + immatriculation)
        NomFichier = .Range("B7") & " " & Format(Now, "dd-mmm-yyyy") & "  " & .Range("E7") & "  " & .Range("F7") & ".pdf"

        If FichierExiste(CheminFichier & NomFichier) = True Then
            
            Application.ExecuteExcel4Macro "SOUND.PLAY(,""C:\Windows\Media\Alarm10.wav"")"
            
            MaRep = MsgBox(NomFichier & vbCrLf & "existe déjà dans le dossier ci-dessous :" & vbCrLf & CheminFichier & vbCrLf & vbCrLf & "                   Faut-il ÉCRASER le fichier existant ?", vbYesNo, "ARCHIVAGE du devis")
            
            If MaRep = vbNo Then Exit Sub
        
        End If


        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=CheminFichier & NomFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False


' MsgBox Buttons:=vbInformation, Prompt:="Devis archivé avec succès", Title:="Pour info"
 
 Application.ExecuteExcel4Macro "SOUND.PLAY(,""C:\WINDOWS\MEDIA\TADA.WAV"")"
 
 
     MsgBox Buttons:=vbInformation, Prompt:="     L'archivage du Devis " & Chr(10) & "     N°-->  " & Sheets("DEVIS").[B7] & Chr(10) & _
                                                                                                                                          "     s'est déroulé avec succès !", Title:="  Info"
   
    End With

End Sub

Merci pour ton aide.
Bien cordialement.
 
Vote positif 0 Vote négatif
AIXELS

AIXELS

XLDnaute Occasionnel
Merci @TooFatBoy
C'est cette ligne qui me pose problème.
Le bouton Oui est sélectionné par défaut.

VB: 
 Rep = MsgBox("              N°--> " & Sheets("DEVIS").[B7] & Chr(10) & "            Ce devis est déjà archivé" & Chr(10) & "                  Dois-je l'ÉCRASER ?", vbYesNo, " N° de devis déjà existant")

Sinon tout le reste fonctionne très bien.
Merci pour ton retour.
Bien cordialement.
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Bon, je viens d'essayer ta solution, et elle fonctionne parfaitement.
Je ne connaissais pas cette possibilité de choisir le bouton par défaut. 👍

Au cas où, je te mets la macro en entier :
VB: 
Private Sub CommandButton4_Click()
'
' ARCHIVER le devis en cours en format PDF (n° devis + date + type + immatriculation)
' Pour réédition duplicata, recherches, et garder un historique
'
Dim CheminFichier$, NomFichier$

    ' Chemin fichier déclaré en variable
    CheminFichier = "C:\XXX\SAUVEGARDES\DEVIS\"
CheminFichier = "D:\M_Detailing\Sauvegardes\Devis\"

    With Sheets("DEVIS")

        ' On crée le nom du fichier de sauvegarde (n° devis + date + type + immatriculation)
        NomFichier = .Range("B7") & " " & Format(Now, "dd-mmm-yyyy") & "  " & .Range("E7") & "  " & .Range("F7") & ".pdf"

        MaRep = vbYes
        If FichierExiste(CheminFichier & NomFichier) Then MaRep = MsgBox(NomFichier & vbCrLf & vbCrLf & "existe déjà dans le dossier" & vbCrLf & CheminFichier & vbCrLf & vbCrLf & vbCrLf & Space(42) & "Écraser le fichier existant ?", vbYesNo + vbInformation + vbDefaultButton2, "Sauvegarde devis")

        If MaRep = vbYes Then
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=CheminFichier & NomFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
            MsgBox Prompt:=Space(5) & "L'archivage du devis" & vbCrLf & Space(5) & "n° " & .[B7] & vbCrLf & Space(5) & "s'est déroulé avec succès !", Buttons:=vbInformation, Title:="  Info"
        End If

    End With

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
AIXELS

AIXELS

XLDnaute Occasionnel
Bonjour @TooFatBoy et tous les Amis du Forum.
Merci pour ton aide et ton retour.
Je comprends mieux l'ordre et la syntaxe pour le bouton
à choisir par défaut. C'est une sécurité quand on répond
trop vite sans prendre le temps de cliquer sur le bon bouton.
on, je viens d'essayer ta solution, et elle fonctionne parfaitement.
Je ne connaissais pas cette possibilité de choisir le bouton par défaut. 👍
Cliquez pour agrandir...
Avec le peu de connaissance que j'ai, je fouille et je suis curieux
de tout. Heureux de te l'avoir fait découvrir et en plus tu es très humble.
C'est une chose rare de nos jours. 👍
Encore milles mercis pour tes retours et pour le temps que tu as
consacré à mon problème.
Bien cordialment.
 
Vote positif 0 Vote négatif
AIXELS

AIXELS

XLDnaute Occasionnel
Bonjour à tous les amis du Forum. :)
J'ai voulu améliorer la macro de sauvegarde du Devis.
Mais "Le mieux est l'ennemi du bien".
J'ai un souci avec l'annulation de la procédure en cas
d'existence du N° de devis dans la base.
La macro s'arrête et doit se terminer sans message.
VB: 
 If Rep = vbNo Then Exit Sub

Le code de la macro :
Code: 
'Sauvegarde pour archivage des Devis dans la Base (onglet HISTORIQUE DEVIS)
'Garder un historique des devis crées à des fins de recherches si nécessaire
Private Sub CommandButton6_Click()

    Dim tablo, DL%, C%
    Dim Ligne As Variant

    Application.ScreenUpdating = True
    Sheets("DEVIS").Select
    Range("B7").Select

    Application.ScreenUpdating = True

    tablo = Array("B7", "C7", "D7", "E7", "E8", "F7", "F8", "F22", "E21")
    With Sheets("HISTORIQUE_DEVIS")
        If Application.CountIf(.[A:A], [B7]) <> 0 Then


            Application.ExecuteExcel4Macro "SOUND.PLAY(,""C:\Windows\Media\Alarm10.wav"")"


            Rep = MsgBox(Buttons:=vbOKCancel + vbDefaultButton2 + vbCritical, Prompt:="    N°--> " & Sheets("DEVIS").[B7] & Chr(10) & "    Ce devis est déjà archivé" & vbNewLine & _
                         "    Dois-je l'écraser ?", Title:="N° de devis déjà existant")
      
      
            If Rep = vbNo Then Exit Sub
            Ligne = Application.Match([B7], .[A:A], 0)
        End If
        If Ligne <> "" Then DL = Ligne Else DL = .Range("A65500").End(xlUp).Row + 1
        For C = 1 To 1 + UBound(tablo)
            .Cells(DL, C) = Range(tablo(C - 1))
        Next C
    
        MsgBox Buttons:=vbInformation, Prompt:="         L'archivage du Devis " & Chr(10) & "       N°-->  " & Sheets("DEVIS").[B7] & Chr(10) & _
                                                                                                                                              "     s'est déroulé avec succès !", Title:="  Info"
    
    End With
        
        MsgBox Buttons:=vbInformation, Prompt:="         L'archivage du Devis " & Chr(10) & "       N°-->  " & Sheets("DEVIS").[B7] & Chr(10) & _
                                                                                                                                              "     s'est déroulé avec succès !", Title:="  Info"

End Sub

Merci pour votre aide.
Bien cordialement.
 

Pièces jointes

  • Boite Annulation.jpg
    Boite Annulation.jpg
    19.4 KB · Affichages: 20
  • Affichage après annulation.jpg
    Affichage après annulation.jpg
    14.1 KB · Affichages: 21
Vote positif 0 Vote négatif
AIXELS

AIXELS

XLDnaute Occasionnel
Bonjour @TooFatBoy
Oui le premier message (fichier joint) le demande.
Par défaut, bouton se place sur annuler.
Même en annulant l'opération, le message (fichier joint)
s'est bien déroulé s'affiche comme même. Bien qu'il y'a
VB: 
If Rep = vbNo Then Exit Sub
Je ne comprends pas pourquoi le message s'affiche
même on annule l'exécution.
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

G
  • Question
Microsoft 365 vba intégrer réf onglet dans code sauvegarde
Réponses
2
Affichages
251
patricktoulon
patricktoulon
J
  • Résolu(e)
XL 2021 plantage lors d'un export format PDF
Réponses
14
Affichages
227
JPaul78
J
M
  • Question
Microsoft 365 Envoi (mail) d'une seule feuille de calcul (active) en pdf
Réponses
7
Affichages
431
patricktoulon
patricktoulon
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
161
Nico2978
Nico2978
B
  • Question
XL 2016 recherche dans une colonne depuis un autre onglet
Réponses
5
Affichages
130
boguinette
B
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Vérifier si elle existe une copie identique
Réponses
2
Affichages
286
chaelie2015
chaelie2015
D
  • Question
XL 2016 Exporter au format PDF dans un dossier existant les colonnes ciblées et en filtrant les lignes qui contiennent une valeur quelconque.
Réponses
6
Affichages
339
Phil69970
Phil69970
K
  • Question
Fusionner tous les PDF d'un dossier
Réponses
5
Affichages
251
crocrocro
C
L
  • Résolu(e)
XL 2019 Important : Nommer fichier grâce aux éléments de publipostage
Réponses
6
Affichages
241
LeForain
L
G
  • Question
XL 2019 Fermer fichier PDF si ouvert avant impression
Réponses
9
Affichages
696
patricktoulon
patricktoulon

Membres actuellement en ligne

4 membres et 43 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
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa