Problème verification existence fichier

cathodique

XLDnaute Barbatruc
Bonjour,

Je me suis aidé de ce que j'ai trouvé sur le forum et là je bloque vraiment.
Je me tourne vers vous car je n'arrive pas à repérer mes erreurs. Je voudrais éditer des feuilles en PDF et créer un classeur. Mais à priori, je voudrais vérifier l'existence de dossiers et fichiers.
C-à-d, si le dossier n'existe pas il est créer et idem pour le fichier avec un message pour confirmer l'écrasement ou pas. Mais mon code sort de la procédure si le fichier n'existe pas, par contre il poursuit son exécution si le fichier existe. Je n'ai vraiment pas compris pourquoi. Je vous remercie pour votre aide.
Code:
Sub Verification_existence_fichier_PDF()
Dim nomdossier As String, chemin As String, Fichier As String, nomfichier As String
'----------------------------------------------------------------------------------------------
Application.ScreenUpdating = True

nomdossier = Year(Sheets("MaFeuille").Range("C1"))
nomfichier = "Situation " & StrConv(Format(Sheets("MaFeuille").Range("C1"), "mmm yyyy"), vbProperCase) & ".pdf"
chemin = ThisWorkbook.Path
 
ChDir chemin 'se place sur le repertoire du programme
 
If Dir(chemin & "\" & nomdossier & "\", vbDirectory) = "" Then
    MkDir chemin & "\" & nomdossier
End If
repert = chemin & "\" & nomdossier
ChDir repert
Fichier = repert & "\" & nomfichier

If Dir(Fichier) <> "" Then If MsgBox("Le fichier existe déjà," & Chr(10) & _
"Voulez-vous l'écraser?", vbYesNo) = vbYes Then GoTo suite:
Exit Sub
suite:
Publier_PDF
End Sub
Sub Publier_PDF()

Sheets(Array("A", "B", "C")).Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fichier, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub
Sub Verification_existence_fichier_Xl()
Dim nomdossier As String, chemin As String, Fichier As String, nomfichier As String
'----------------------------------------------------------------------------------------------
Application.ScreenUpdating = True
Application.DisplayAlerts = False

nomdossier = Year(Sheets("MaFeuille").Range("C1"))
nomfichier = "Situation " & StrConv(Format(Sheets("MaFeuille").Range("C1"), "mmm yyyy"), vbProperCase) & ".xls"

chemin = ThisWorkbook.Path
 
ChDir chemin 'se place sur le repertoire du programme
 
If Dir(chemin & "\" & nomdossier & "\", vbDirectory) = "" Then
    MkDir chemin & "\" & nomdossier
End If
repert = chemin & "\" & nomdossier
ChDir repert
Fichier = repert & "\" & nomfichier

If Dir(Fichier) <> "" Then If MsgBox("Le fichier existe déjà," & Chr(10) & _
"Voulez-vous l'écraser?", vbYesNo) = vbYes Then GoTo suite:
Exit Sub
suite:
'création fichier xl
Création_Classeur
End Sub
Sub Création_Classeur()
Application.ScreenUpdating = False
chemin = ThisWorkbook.Path
nomfichier = "Situation " & StrConv(Format(Sheets("MaFeuille").Range("C1"), "mmm yyyy"), vbProperCase) & ".xls"
    
    Workbooks.Add.Activate
    ActiveWorkbook.SaveAs nomfichier
    Sheets("Feuil1").Name = "A"
    Sheets("Feuil2").Name = "B"
    Sheets("Feuil3").Name = "C"
    Sheets("Feuil4").Name = "D"  **code plante aussi ici
 Application.ScreenUpdating = True

End Sub
Pour la procédure de création du classeur, le code bug sur la ligne qui nomme la 4ème feuille. Je suppose que c'est parce que par défaut Excel ouvre un nouveau classeur avec 3 feuilles. Comment faire, sans passer par les options d'Excel à forcer la création d'un nouveau classeur avec 4 feuilles?

Je vous remercie par avance.

Cordialement,
 

Pièces jointes

  • Création classeur.xls
    62.5 KB · Affichages: 33

Staple1600

XLDnaute Barbatruc
Re : Problème verification existence fichier

Bonjour ç tous


A vue de nez , je dirai qu'il y a un \ de trop ici
If Dir(chemin & "\" & nomdossier & "\", vbDirectory) = "" Then
MkDir chemin & "\" & nomdossier
End If
Donc si j'étais toi, j'essaierai comme ceci
If Dir(chemin & "\" & nomdossier , vbDirectory) = "" Then
MkDir chemin & "\" & nomdossier
End If
 

cathodique

XLDnaute Barbatruc
Re : Problème verification existence fichier

Bonsoir Staple1600,

je m'excuse pour le retard (obligation avec les enfants). J'ai essayé avec ta correction mais le résultat est le même. c'est à dire, si le fichier n'existe pas la procédure ne se termine pas (exit sub). Par contre, quand je crée moi-même "manuellement" le fichier, j'ai le message pour confirmer l'écrasement. je suis vraiment embarrassé, ça me bloque pour avancer sur ce fichier.

je te remercie beaucoup et je suis content de te "revoir".

Cordialement,
 

cathodique

XLDnaute Barbatruc
[Résolu] : Problème verification existence fichier

Re,

Hourra!!! Après un bon bol d'air avec les enfants, j'ai trouvé mes erreurs. Enfin, c'est ce que je pense.
Voici les codes corrigés
Code:
Sub Verification_existence_fichier_PDF()
Dim nomdossier As String, chemin As String, Fichier As String, nomfichier As String

Application.ScreenUpdating = True

nomdossier = Year(Sheets("MaFeuille").Range("C1"))
nomfichier = "Situation " & StrConv(Format(Sheets("MaFeuille").Range("C1"), "mmm yyyy"), vbProperCase) & ".pdf"
chemin = ThisWorkbook.Path
 
ChDir chemin 'se place sur le repertoire du programme
 
If Dir(chemin & "\" & nomdossier & "\", vbDirectory) = "" Then
    MkDir chemin & "\" & nomdossier
End If
repert = chemin & "\" & nomdossier
ChDir repert
Fichier = repert & "\" & nomfichier

If Dir(Fichier) <> "" Then If MsgBox("Le fichier existe déjà," & Chr(10) & _
"Voulez-vous l'écraser?", vbYesNo) = vbNo Then GoTo suite:

Sheets(Array("A", "B", "C")).Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fichier, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

suite: Sheets("MaFeuille").Activate

End Sub
'----------------------------------------------------------------------------------------------
Sub Verification_existence_fichier_Xl()
Dim nomdossier As String, chemin As String, Fichier As String, nomfichier As String

Application.ScreenUpdating = True
Application.DisplayAlerts = False

nomdossier = Year(Sheets("MaFeuille").Range("C1"))
nomfichier = "Situation " & StrConv(Format(Sheets("MaFeuille").Range("C1"), "mmm yyyy"), vbProperCase) & ".xls"

chemin = ThisWorkbook.Path
 
ChDir chemin 'se place sur le repertoire du programme
 
If Dir(chemin & "\" & nomdossier & "\", vbDirectory) = "" Then
    MkDir chemin & "\" & nomdossier
End If
repert = chemin & "\" & nomdossier
ChDir repert
Fichier = repert & "\" & nomfichier

If Dir(Fichier) <> "" Then If MsgBox("Le fichier existe déjà," & Chr(10) & _
"Voulez-vous l'écraser?", vbYesNo) = vbNo Then GoTo suite:

    Application.SheetsInNewWorkbook = 4   'ouvre nouveau classeur avec 4 feuilles
    Workbooks.Add.Activate
    ActiveWorkbook.SaveAs nomfichier
    Sheets("Feuil1").Name = "A"
    Sheets("Feuil2").Name = "B"
    Sheets("Feuil3").Name = "C"
    Sheets("Feuil4").Name = "D"

suite: End
 Application.ScreenUpdating = True
End Sub

Mes erreurs étaient, vbNo au lieu de vbYes et le renvoi du GoTo suite:
A vue de nez , je dirai qu'il y a un \ de trop ici
If Dir(chemin & "\" & nomdossier & "\", vbDirectory) = "" Then
MkDir chemin & "\" & nomdossier
Donc si j'étais toi, j'essaierai comme ceci
If Dir(chemin & "\" & nomdossier , vbDirectory) = "" Then
MkDir chemin & "\" & nomdossier
End If
Par contre, j'ai gardé le 2ème "\" et ça fonctionne. Est-il correct, de garder le 2ème "\"? Je ne le sais pas.

Je te remercie beaucoup pour ton aide. Voilà, mon problème est résolu, je vais pouvoir poursuivre mon travail.

Bonne soirée.

Cordialement,
 

Discussions similaires

Statistiques des forums

Discussions
312 371
Messages
2 087 704
Membres
103 646
dernier inscrit
ouattara dad