[Résolu] Création de dossier et impression Excel 2011

Gilles52300

XLDnaute Junior
Bonjour,

j'essaye tant bien que mal de créer un nouveau dossier. Si il n'existe pas, je veux le créer. Dans ce dossier je veux enregistrer des fichiers excel d'un même client. (le temps que je trouve comment imprimer un pdf en vba)
voici mon code actuel.
Quand je lance la macro il me dit code erreur 68 (périphérique non disponible) sur l'avant dernière ligne du code ci dessous.

si vous pouviez m'aider? merci bien.

Code:
Sheets("rapport").Select 
Chemin = "Macintosh OS:Users:gilles:Travail:Haiti:Chantiers:BETON"
Client = ":" & Range("C4")                    'nom du client
Fichier = Range("H4") & ".xls"               'c'est un numéro différent à chaque fois
If Dir(Chemin & Client, (vbNormal)) = "" Then MkDir Chemin & Client
ActiveWorkbook.SaveAs Chemin & Client & "\" & Fichier



Voici le code pour créer de nouveau dossier et lancer l'impression en Pdf. Après une galère de 3 jours, je préfères éviter cela à d'autre.

Bien entendu vous devrez l'adapter à vos besoin surtout en ce qui concerne le chemin directeur.
A positionner avant le End sub ou alors ou vous avez besoin de faire ces opérations.

Code:
Dim Chemin$, Client$, Fichier$
Dim Exist, mXls As Object
'Séléction de la feuille 
    Sheets("XXXX").Select
'sans ce bout de code de 4 lignes, vous avez une erreur comme quoi le fichier est introuvable. 
        On Error Resume Next
        Set mXls = GetObject(, "Xls.Application")
        If Err Then
            Set mXls = CreateObject("Xls.Application")
        End If
 Application.DisplayAlerts = False
'recherche et création d'un classeur si il n'éxiste pas.
        Exist = 0
'sur Mac le chemin se défini comme suit. Macintosh OS ou HD c'est celons votre Mac vous trouverez la racine correspondant en regardant dans le finder. Les "/" sont remplacés par le ":" 
        ChDir "Macintosh OS:Users:XXXXXXXX:Travail:Haiti:Chantiers:Beton:nClient:"
        Chemin = Dir(Client, vbDirectory) ' Extrait la première entrée.
            Do While Chemin <> "" ' Commence la boucle.
                If Chemin <> "." And Chemin <> ".." Then
                    If (GetAttr(Client & Chemin) _
                    And vbDirectory) = vbDirectory Then
                    Exist = 1
            Exit Do
                    End If
                End If
            Loop
            If Exist = 0 Then
                MkDir (Client)
            End If
'pour lancer l'impression en PDF et enregistrer dans le dossier correspondant.
    'on determine le chemin d'accès
        ChDir "Macintosh OS:Users:marcingilles:Travail:Haiti:Chantiers:Beton:nClient:" & Client
        Fichier = Dir(Client, vbDirectory) & Fichier
    'impression au format .PDF
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fichier, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        ignorePrintAreas:=False, OpenAfterPublish:=True
Application.DisplayAlerts = true

Merci pour les aides de l'équipe et de Denis
 
Dernière édition:
D

Denis

Guest
Re : code erreur 68 à la création d'un nouveau classeur

Bonjour Gilles52300 et le forum
essais ceci extrait de l'aide VBA: (non testé)
Dim MyFile, MyPath, MyName, Exist
Exist = 0
' Affiche les noms dans C:\ représentant des dossiers.
MyPath = "c:\" ' Définit le chemin d'accès.
MyName = Dir(MyPath, vbDirectory) ' Extrait la première entrée.
Do While MyName <> "" ' Commence la boucle.
' Ignore le dossier courant et le dossier
' contenant le dossier courant.
If MyName <> "." And MyName <> ".." Then
' Utilise une comparaison au niveau du bit pour
' vérifier que MyName est un dossier.
If (GetAttr(MyPath & MyName) _
And vbDirectory) = vbDirectory Then
Exist = 1
'ici tu mets ta ligne "save as ...."
'puis "exit do" pour sortir de la boucle

End If
End If
MyName = Dir ' Extrait l'entrée suivante.
Loop
if Exist = 0 then 'arrivé ici, c'est que le répertoire n'existe pas donc création du répertoire et enregistrement


Bon courage et à +
Denis
 

Gilles52300

XLDnaute Junior
Re : code erreur 68 à la création d'un nouveau classeur

Bonjour Tout le monde,
Un peu de retard dans la réponse, mais j'ai 6 heures en moins avec la France alors ne m'en veuillez pas.

Merci Denis pour ta réponse.
Je regarde la piste que tu m'as fourni et je te tiens au courant.
A+
Gilles
 

Gilles52300

XLDnaute Junior
Re : code erreur 68 à la création d'un nouveau classeur

Re bonjour,
Je viens de tester et .....
Toujours la même erreur code 68
Je fouille, fouille pour trouver, mais rien.
Tant que j'y suis, vous n'auriez pas un code pour lancer l'impression d'une feuille en PDF?
Je vous tiens au courant de l'avancé de mes recherches.
merci.

EUREKA​
C'est tout bon, comme ceci ça fonctionne nickel.


Code:
Sheets("rapport").Select
            
Dim MyName, Exist, mWord As Object
On Error Resume Next
Set mWord = GetObject(, "Word.Application")
If Err Then
Set mWord = CreateObject("Word.Application")
End If
mWord.DisplayAlerts = False

                Exist = 0
                Client = ":" & Range("C4")
                ChDir "Macintosh OS:Users:gilles:Travail:Haiti:Chantiers:Beton:nClient:" & Client
                MyName = Dir(Client, vbDirectory) ' Extrait la première entrée.
                Do While MyName <> "" ' Commence la boucle.
                If MyName <> "." And MyName <> ".." Then
                If (GetAttr(Client & MyName) _
                And vbDirectory) = vbDirectory Then
                Exist = 1
                ActiveWorkbook.SaveAs Client
                Exit Do
                
                End If
                End If
                'MyName = Dir ' Extrait l'entrée suivante.
                Loop
                If Exist = 0 Then
                MkDir (Client)
                End If
 
Dernière édition:

Discussions similaires

Réponses
11
Affichages
206
Réponses
2
Affichages
252

Statistiques des forums

Discussions
311 720
Messages
2 081 926
Membres
101 842
dernier inscrit
seb0390