VBA Chemin d'enregistrement variable, erreur 1004 doc non enregistrés

Bonjour,

Je me permets de solliciter la communauté pour m'aider à résoudre un problème sur lequel je bute depuis maintenant plusieurs heures.

Je travail sur la création d'une application d'évaluation de compétences qui sera utilisée par plusieurs utilisateurs sur plusieurs machines.

Lorsque l'utilisateur a terminé, il peut enregistrer le résultat de cette évaluation au format pdf suivant un chemin précis

"C:\Users\" & Environ("username") & "\Documents\EVAL_EPS\" & Sheets("Feuil6").Range("R4") & "\" & Sheets("Feuil6").Range("K2") & "\"

Mon problème est le suivant tout fonctionne à merveille sur ma tablette surface pro 4.

Mais si je l'utilise sur l'une des surfaces pro 6 du boulot (ce qui sera le cas, l'application est crée pour ça) ça me renvoie une

"erreur d'execution 1004 documents non enregistrés le document peutêtre ouvert ou une erreur s'est produite lors de l'enregistrement."

Je ne comprends pas d'où vient le problème car j'ai justement utilisé environ (username) pour pouvoir utiliser l'appli sur n'importe quelle machine, quelque soit le nom utilisateur (puisque les collègues seront amenés à l'utiliser également).

Les dossiers de destinations sont créés s'ils n'existent pas via ce module bien pratique trouvé sur le net :

Function CreerDossier(Chemin As String)

On Error GoTo CreerDossierErreur

Dim PremierDossier As String

Dim CheminReseau As Boolean

Dim CheminPartielOK As String

Dim CheminPartiel, PartieDeChemin As Integer

Dim PartiesDeChemin As Variant

Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")

If Len(Dir(Chemin, vbDirectory)) > 0 Then

CreerDossier = True

Exit Function

Else

'suppression du dernier backslash si présent

If Right(Chemin, 1) = Application.PathSeparator Then Chemin = Left(Chemin, Len(Chemin) - 1)

'vérificacion si chemin local ou réseau

If Left(Chemin, 2) = "\\" Then

CheminReseau = True

Else

CheminReseau = False

End If

'décomposition du chemin

If CheminReseau = False Then

PartiesDeChemin = Split(Chemin, Application.PathSeparator)

CheminPartielOK = ""

PremierDossier = LBound(PartiesDeChemin)

Else

PartiesDeChemin = Split(Replace(Chemin, "\\", ""), Application.PathSeparator)

CheminPartielOK = ""

PremierDossier = LBound(PartiesDeChemin) + 1

End If

'tests et créations de (sous)dossiers

For PartieDeChemin = PremierDossier To UBound(PartiesDeChemin)

For CheminPartiel = LBound(PartiesDeChemin) To PartieDeChemin

If CheminReseau = False Then

CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & Application.PathSeparator

Else

CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & Application.PathSeparator

End If

If CheminPartiel = PartieDeChemin Then

If CheminReseau = False Then

If FSO.FolderExists(CheminPartielOK) = False Then

MkDir CheminPartielOK

End If

Else

If Right(CheminPartielOK, 1) = Application.PathSeparator Then _

CheminPartielOK = Left(CheminPartielOK, Len(CheminPartielOK) - 1)

If Left(CheminPartielOK, 2) <> "\\" Then _

CheminPartielOK = "\\" & CheminPartielOK

If FSO.FolderExists(CheminPartielOK) = False Then

MkDir CheminPartielOK

End If

End If

End If

Next CheminPartiel

CheminPartielOK = ""

Next PartieDeChemin

End If

CreerDossier = True

Exit Function

CreerDossierErreur:

CreerDossier = False

End Function

Sub ExempleCreationDossierAvecSousdossiers()

'par: Excel-Malin.com ( https://excel-malin.com )

On Error GoTo ExempleErreur

Dim NouveauDossierAvecSousDossiers As String

NouveauDossierAvecSousDossiers = "C:\Users\" & Environ("username") & "\Documents\EVAL_EPS\" & Sheets("Feuil6").Range("R4").Value & "\" & Sheets("Feuil6").Range("K2").Value

CreerDossier (NouveauDossierAvecSousDossiers)

Exit Sub

ExempleErreur:

MsgBox "Une erreur est survenue..."

End Sub

Et enfin ci après le module avec la ligne pointée par le débogage :

Sub Export_PDF()

'

Dim Répertoire As Variant

Dim Fichier As String

Dim feuille As Variant

Dim Nom As Name

Répertoire = "C:\Users\" & Environ("username") & "\Documents\EVAL_EPS\" & Sheets("Feuil6").Range("R4") & "\" & Sheets("Feuil6").Range("K2") & "\" 'Dossier de destination des fichiers PDF créés

With Worksheets("Feuil6").Range("G1:S49")

'On donne au fichier PDF le nom de la feuille active

Fichier = Sheets("Feuil6").Range("R4") & "___" & Sheets("Feuil6").Range("H4") & "___" & Format(Date, "dd.mm.yyyy") & ".pdf"

Chemin = Répertoire & Fichier

'On crée le nouveau document au format PDF

.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

End With

End Sub

J'ai pas mal cherché sur le net pour des problèmes similaires, j'ai tenté plusieurs choses mais au mieux j'obtiens que ça ne bug pas, sans obtenir l'enregistrement suivant le chemin spécifié... D'avance je vous remercie de votre aide !

cordialement

jb

Après plusieurs manipulation il semble que ce soit users qui bloque sans que je comprenne pourquoi.

En effet si je supprime cette étape du chemin et que je ne laisse que :

"C:\" & Environ("username") & "\Documents\EVAL_EPS\" & Sheets("Feuil6").Range("R4").Value & "\" & Sheets("Feuil6").Range("K2").Value

au lieu de

"C:\users\" & Environ("username") & "\Documents\EVAL_EPS\" & Sheets("Feuil6").Range("R4").Value & "\" & Sheets("Feuil6").Range("K2").Value

ça fonctionne...Si quelqu'un est en mesure de m'expliquer pourquoi et comment résoudre ça...

Merci.

Bonjour,

Environ$("Userprofile") comprend le chemin parent ainsi que l'unité (C:)

Fait ce test ...

Sub tests()
   Path = Environ$("Userprofile") 
   MsgBox Path
End Sub

Selon ton code, tu devrais tester ... Environ$("Userprofile") & "\Documents\EVAL_EPS\" & Sheets("Feuil6").Range("R4").Value & "\" & Sheets("Feuil6").Range("K2").Value

Sans mentionner l'unité ni le dossier Users.

ric

Excellent ! Problème réglé.

Je marque comme résolu et je te remercie de ton aide !

ric