Créer un dossier pour chaque pdf

[tactic6]

Bonjour tout le monde
j'ai un petit truc qui me turlupine et dont je ne voie pas la solution

un petit prog excel me "fabrique" des classeurs exel avec des feuilles dont le nombre varie en fonction des données

avec une autre macro je transforme toutes les feuilles en .pdf
jusque là tout va bien
le petit truc qu'il me faudrait c'est de pouvoir créer ces .pdf dans le même chemin que le classeur excel ( actuellement ça va dans mes documents) et la cerise sur le gâteau serait de mettre tous les pdf dans un même dossier

Voici le bout de code qui va surement en intéresser plus d'un
Merci

Sub Macro1()
ChDir ActiveWorkbook.Path
For Each sh In Sheets
    If Application.CountA(sh.Cells) > 0 Then
        Akw = sh.Name & ".pdf"
        sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Akw
    End If
Next sh
End Sub

 

[vbacrumble]

Re : Créer un dossier pour chaque pdf

Bonjour


Essayes ainsi

Sub Macro1()
Dim Chemin$
Chemin ="C:\Toto\" 'ici mettre le nom du dossier et le nom du lecteur
For Each sh In Sheets
    If Application.CountA(sh.Cells) > 0 Then
        Akw = sh.Name & ".pdf"
        sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & Akw
    End If
Next sh
End Sub

 

[tactic6]

Re : Créer un dossier pour chaque pdf

Merci pour ton aide
j'ai changé
Chemin :"
par
Chemin = "

maintenant le chemin est ok mais il me reste le pb du nouveau dossier

serait il possible que tous les pdf soient dans un même et unique classeur avec un nom bien spécifique ?

 

[vbacrumble]

Re : Créer un dossier pour chaque pdf

RE


Oui désolé pour l'oubli su signe égal

Mais théoriquement avec ton code modifié les pdf sont bien dans le dossier C:\toto non ?

 

[tactic6]

Re : Créer un dossier pour chaque pdf

Re
oui en effet mais tous les pdf se melangent et la recherche est difficile
si j'avais la possibilité de les classer à chaque coup de clic sur macro dans un dossier avec un nom en fonction d'une cellule du fichier excel le travail serait beaucoup plus efficace
tu me comprends ?

a la limite créer un texbox me demandant sous quel nom nommer le répertoire de sauvegarde
pourquoi pas

 

[kiki29]

Re : Créer un dossier pour chaque pdf

Salut, pour la création de dossier, à adapter

Option Explicit

'        http://msdn2.microsoft.com/en-us/library/bb762131.aspx
'
'        ERROR_BAD_PATHNAME         The pszPath parameter was set to a relative path.
'        ERROR_FILENAME_EXCED_RANGE The path pointed to by pszPath is too long.
'        ERROR_PATH_NOT_FOUND       The system cannot find the path pointed to by pszPath.
'                                   The path may contain an invalid entry.
'        ERROR_FILE_EXISTS          The directory exists.
'        ERROR_ALREADY_EXISTS       The directory exists.
'        ERROR_CANCELLED

Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, ByVal pszPath As String, _
                                              ByVal lngsec As Long) As Long

Private Const ERROR_BAD_PATHNAME As Long = 161&
Private Const ERROR_FILENAME_EXCED_RANGE As Long = 206&
Private Const ERROR_PATH_NOT_FOUND As Long = 3&
Private Const ERROR_FILE_EXISTS As Long = 80&
Private Const ERROR_ALREADY_EXISTS As Long = 183&
Private Const ERROR_CANCELLED As Long = 1223&

Sub Tst_CreationDossier()
Dim sDossier As String, Rep As Long
    sDossier = "C:\Essai1\Essai2\Essai3\Essai4\Essai5"
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Sub

 

[MJ13]

Re : Créer un dossier pour chaque pdf

Bonjour à tous

Kiki29, ta macro permet de créer un dossier avec sous-dossier sans le faire en plusieurs fois, c'est génial ton truc.

Merci beaucoup, j'usqu'ici, je le faisait par dossier (merci aussi a msdn2 en passant).

 

[tactic6]

Re : Créer un dossier pour chaque pdf

Bonjour et Merci a tous
Kiki29 ta macro est super mais je n'arrive pas a l'integrer à mon code
voici les modules que j'utilise
si quelqu'un arrive à voir où est l'erreur...

Sub Enregistrement()
Application.ScreenUpdating = True
Const DossierSauvegarde As String = "H:\Contrat Maintenance\"
Dim Nom_fichier As String
ReDim Feuilles(1 To 1)
Dim Compteur As Integer
Compteur = 0
Dim Feuille As Worksheet
For Each Feuille In Sheets
If Feuille.Range("F6").Value > 0 Then 'Ici la condition est que le nombre soit > 0
Compteur = Compteur + 1
ReDim Preserve Feuilles(1 To Compteur)
Feuilles(Compteur) = Feuille.Name
End If
Next Feuille
If Compteur > 0 Then Sheets(Feuilles).Copy
Nom_fichier = Sheets("SYNTHESE").Range("D8") & " " & Sheets("SYNTHESE").Range("D11")
ActiveWorkbook.SaveAs DossierSauvegarde & Nom_fichier & " ", FileFormat:=-4143, CreateBackup:=False
Call Tst_CreationDossier
End Sub




Sub Tst_CreationDossier()
Dim sh As Sheets
Dim Akw As Workbook
Dim sDossier As String, Rep As Long
    sDossier = "H:\Contrat Maintenance\pdf"
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
    For Each sh In Sheets ' on crée les pdf
    If Application.CountA(sh.Cells) > 0 Then
        Akw = sh.Name & ".pdf"
        sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sDossier & Akw
    End If
Next sh

End Sub

merci

 

[kiki29]

Re : Créer un dossier pour chaque pdf

Salut si placé dans un module à part changer Private en Public

[b]Private[/b] Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, ByVal pszPath As String, _
                                              ByVal lngsec As Long) As Long

Sub Tst_CreationDossier()
Dim sh As Worksheet
Dim Akw As String
Dim sDossier As String, Rep As Long
    sDossier = "H:\Contrat Maintenance\pdf"
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
    For Each sh In Worksheets
        If Application.CountA(sh.Range("A1:A26")) > 0 Then
            Akw = sh.Name & ".pdf"
            sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sDossier & "\" & Akw
        End If
    Next sh
End Sub

 

[tactic6]

Re : Créer un dossier pour chaque pdf

Merci pour ton aide précieuse
bien sur ça fonctionne🙂