Discussion :

[jean30]

Bonjour
Dans ce code réalisé par un ami, j'ai une erreur à la ligne 8, (MkDir chDos & Dos) - Erreur 76 Chemin d'accès introuvable
Je vous remercie de bien vouloir le corriger
Ce code a été réalisé par un ami hospitalisé
En vous remerciant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Btn_ValiderSaisie_Click()
Dim chDos$, Dos$, Fich$
'Création dossier et enregistrement fichiers dans dossier créé
chDos = Environ("userprofile") & "\Desktop\"
Dos = "NouvelFiche"
'Crée le dossier sur le bureau en C:\Utilisateurs\xxxxx\ Desktop
If Dir(chDos & Dos, vbSystem + vbDirectory + vbHidden) = "" Then _
MkDir chDos & Dos
chDos = chDos & Dos & "\"
Fich = Me.Range("A4") & " " & Me.Range("K4") & ".xls"
Application.DisplayAlerts = False
ThisWorkbook.SaveCopyAs chDos & Fich
If MsgBox("Autre fiche à établir ?", vbQuestion + vbYesNo, "Saisie fiche") = vbYes Then
If MsgBox("Souhaitez-vous que les saisies antérieures soient effacées ?", _
vbQuestion + vbYesNo, "Saisie fiche") = vbYes Then
EffacerFiche
End If
Else
If MsgBox("Voulez-vous que le dossier de fiches validées soit compressé ?", _
vbQuestion + vbYesNo, "Compression dossier") = vbYes Then
chDos = Left(chDos, Len(chDos) - 1)
CompresserNouvelFiche chDos, chDos & ".zip"
EffacerFiche
End If
End If
[AB2].Value = "ADD"
End Sub

[WuKoDLaK]

bonjour à toi,

il serait intéressant de savoir de quelle erreur il s'agit.
que t'affiche excel à l'exécution ?

[jean30]

Bonjour WuKoDLaK
Merci de t'intéresser à ma demande
Ça indique : Erreur 76 Chemin d'accès introuvable

[Patrice740]

Bonjour,

Ça indique : Erreur 76 Chemin d'accès introuvable

Le bureau ne se trouve pas toujours dans %userprofile% !

Remplaces la ligne :

Code VB :

Sélectionner tout - Visualiser dans une fenêtre à part

chDos = Environ("userprofile") & "\Desktop\"

par les 3 lignes suivantes :

Code VB :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim Obj As Object
Set Obj = CreateObject("WScript.Shell")
chDos = Obj.SpecialFolders("Desktop") & "\"

[jean30]

Bonjour Patrice,
Je te remercie beaucoup c'est parfait
Au plaisir et bonne soirée