Besoin d'aide sur un projet Excel VBA

Version imprimable

06/06/2024, 20h50
kodyone

3 pièce(s) jointe(s)

Besoin d'aide sur un projet Excel VBA

Bonsoir j'espère que vous allez bien ?
J'ai besoin d'aide sur un code qui ne me donne pas le résultat attendu.

Je veux que ce code me crée un sous dossier dans le repertoire Document comme suit :
"C:\Users\hp\Documents\Gestion Secretariat"

Ensuite dans le dossier "Gestion Secretariat", je veux qu'il me place un sous dossier que je vais saisir dans le Inputbox comme par exemple le mois de Juin. du genre à me donnée ;
"C:\Users\hp\Documents\Gestion Secretariat\Juin"
Et dans le Dossier Juin enregistrer exporter ma feuille en cours en PDF.

Malheureusement ça me donne ce qu'il y'a dans l'image 2

Alors que je voulais que ça soit comme dans l'image 3 avec le fichier pdf à l'intérieur.

Merci de m'aider à parfaire ce code.
06/06/2024, 21h05
Thumb down

Bonsoir,
Désolé je ne suis pas un vertuose de photos shop.
06/06/2024, 21h19
kodyone

Citation:

Envoyé par Thumb down

Bonsoir,
Désolé je ne suis pas un vertuose de photos shop.

Ce n'est pas du Photoshop, c'est sur Excel

Salut, teste comme ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub ExporterEnPDF()
    Dim NomDossier As String
    Dim Chemin As String
    Dim Dossier As String
    Dim DossierExistant As Boolean
 
    NomDossier = Application.InputBox("Nom du Dossier", "Création du Dossier", "Entrez le nom du Dossier")
    Chemin = "C:\Users\hp\Documents\Gestion Secretariat\" & NomDossier & "\"
    Dossier = "C:\Users\hp\Documents\Gestion Secretariat\" & NomDossier
 
    On Error GoTo ErrHandler
    DossierExistant = Dir(Dossier, vbDirectory) <> ""
 
    If Not DossierExistant Then
        MkDir Chemin
    End If
 
    Sheets("Rapport Journalier").Activate
    ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Chemin & "Rapport_du_" & Range("E8").Value & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
 
    MsgBox "Le Rapport du " & Format(Range("E10").Value, "DD-MM-YYYY") & " a été sauvegardé dans votre dossier. Veuillez songer à l'envoyer au Boss pour visa"
    Exit Sub
 
ErrHandler:
    MsgBox "Une erreur s'est produite: " & Err.Description
End Sub

Citation:

Envoyé par Franc

Salut, teste comme ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub ExporterEnPDF()
    Dim NomDossier As String
    Dim Chemin As String
    Dim Dossier As String
    Dim DossierExistant As Boolean
 
    NomDossier = Application.InputBox("Nom du Dossier", "Création du Dossier", "Entrez le nom du Dossier")
    Chemin = "C:\Users\hp\Documents\Gestion Secretariat\" & NomDossier & "\"
    Dossier = "C:\Users\hp\Documents\Gestion Secretariat\" & NomDossier
 
    On Error GoTo ErrHandler
    DossierExistant = Dir(Dossier, vbDirectory) <> ""
 
    If Not DossierExistant Then
        MkDir Chemin
    End If
 
    Sheets("Rapport Journalier").Activate
    ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Chemin & "Rapport_du_" & Range("E8").Value & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
 
    MsgBox "Le Rapport du " & Format(Range("E10").Value, "DD-MM-YYYY") & " a été sauvegardé dans votre dossier. Veuillez songer à l'envoyer au Boss pour visa"
    Exit Sub
 
ErrHandler:
    MsgBox "Une erreur s'est produite: " & Err.Description
End Sub

Merci bien pour votre contribution.
Ce code fonctionne que lorsque le dossier est déjà créé, pourtant mois je veux que si le dossier est inexistant qu'il me le crée automatiquement et qu'il place le fichier pdf à l'intérieur

Citation:

Envoyé par Franc

Salut, teste comme ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub ExporterEnPDF()
    Dim NomDossier As String
    Dim Chemin As String
    Dim Dossier As String
    Dim DossierExistant As Boolean
 
    NomDossier = Application.InputBox("Nom du Dossier", "Création du Dossier", "Entrez le nom du Dossier")
    Chemin = "C:\Users\hp\Documents\Gestion Secretariat\" & NomDossier & "\"
    Dossier = "C:\Users\hp\Documents\Gestion Secretariat\" & NomDossier
 
    On Error GoTo ErrHandler
    DossierExistant = Dir(Dossier, vbDirectory) <> ""
 
    If Not DossierExistant Then
        MkDir Chemin
    End If
 
    Sheets("Rapport Journalier").Activate
    ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Chemin & "Rapport_du_" & Range("E8").Value & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
 
    MsgBox "Le Rapport du " & Format(Range("E10").Value, "DD-MM-YYYY") & " a été sauvegardé dans votre dossier. Veuillez songer à l'envoyer au Boss pour visa"
    Exit Sub
 
ErrHandler:
    MsgBox "Une erreur s'est produite: " & Err.Description
End Sub

J'ai pu finalement bien compris votre code et je pense que ça fonctionne bien maintenant.
Merci grandement.