Pourquoi mon code plante

[Arpette]

Bonjour à toutes et à tous,

J'ai un module qui créé un dossier et sous dossier si il(s) n'existent pas. Pour certains il me donne une erreur à la création du sous répertoire avec message :
" Chemin d'accès introuvable erreur 76" alors que le module est identique pour tous les fichiers.

Voici le code :
Sub Enregister()
' Enregistrer Sous
Application.EnableEvents = False
Dim Lechemin As String
Dim LeFichier As String
Dim NomRep As String
Dim SousRep As String

'\***************************************************************************************************************************
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Lechemin = ActiveWorkbook.Path

Cells(5, 4) = Cells(12, 8).Value 'Met le n° de parc en C5
Cells(5, 8) = Cells(15, 18).Value 'Met le N° d'immatriculation en H15

Nom = Cells(4, 3)

NomClient = Cells(39, 11).Value

Numimmat = Cells(15, 18).Value

NomRep = NomClient

Marque = Cells(9, 8).Value

NumParc = Cells(12, 8).Value

Jour = Format(Cells(49, 9), "dd-MM-YYYY")

MoisAn = Right(Jour, 7)

SousRep = MoisAn

LeFichier = Nom & " _ " & Numimmat & " _ " & NomClient & " _ " & Marque & " _ " & NumParc & " _ " & Jour
'\***************************************************************************************************************************
Lechemin = "F:\CONTROLES CLIENTS\"

If Dir(Lechemin & NomRep, vbDirectory) = "" Then MkDir Lechemin & NomRep 'Vérifie la présence du répertoire, si manquant création

If Dir(Lechemin & NomRep & "\" & SousRep, vbDirectory) = "" Then MkDir Lechemin & NomRep & "\" & SousRep 'Vérifie la présence du sous répertoire, si manquant création

ActiveWorkbook.SaveAs Lechemin & NomRep & "\" & SousRep & "\" & LeFichier


ActiveWorkbook.ActiveSheet.Select

With ActiveSheet.PageSetup
VEntete = ActiveSheet.Cells(4, 3).Value
VEntete1 = ActiveSheet.Cells(5, 3).Value & Cells(5, 4).Value & _
" " & Cells(5, 7).Value & " " & Cells(5, 8).Value
.LeftHeader = "&""BOOK ANTIQUA,Gras italique""&21" & VEntete & Chr(10) & _
"&""BOOK ANTIQUA,Gras italique""&15&KFF0000" & VEntete1

End With

Sheets(Sheets.Count).Select 'Positionne sur dernière feuille
With ActiveSheet.PageSetup
VEntete = VEntete
VEntete1 = VEntete1
.LeftHeader = "&""BOOK ANTIQUA,Gras italique""&21" & VEntete & Chr(10) & _
"&""BOOK ANTIQUA,Gras italique""&15&KFF0000" & VEntete1
End With

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'\***************************************************************************************************************************
Sheets("Page 1").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
ThisWorkbook.Close SaveChanges:=True
End Sub

Merci de votre aide
@+

 

[JCGL]

Bonjour à tous,

Cells(5, 4) est D5

A+ à tous

Edition : Salut Dodo, salut l'Agrafe.

 

[Lone-wolf]

Bonjour Arpette,

parce qu'il y a plusieurs erreurs dans ton code. D'abord ici

Sub Enregister()
' Enregistrer Sous
Application.EnableEvents = False
Dim Lechemin As String
Dim LeFichier As String
Dim NomRep As String
Dim SousRep As String

Application.EnableEvents = False vient après la déclaration des variables, (Appl.E.E pas obligatoire).

Application.ScreenUpdating = False

Cells(5, 4) = Cells(12, 8).Value - Cells(5, 8) = Cells(15, 18).Value de quelle feuille??

With ActiveWorkbook.Sheets("Feuil3")
.Cells(5, 4) = ThisWorkbook.Sheets("Feuil13").Cells(12, 8).Value
Cells(5, 8) = ThisWorkbook.Sheets("Feuil13").Cells(15, 18).Value
End with

Ensuite Lechemin = ActiveWorkbook.Path > Lechemin = "F:\CONTROLES CLIENTS\", lequel est le bon???

ActiveWorkbook.ActiveSheet.Select , double erreur, si la feuille est active pourquoi la sélectionner??? Et qu'elle nom porte la feuille active???

With ActiveWorkbook.Sheets("Feuil 3")
le reste du code
End With

Sheets(Sheets.Count).Select faux. Mais à la place With Sheets("Feuil13") par exemple

Cells.Select, tu veux aussi copier les lignes vides??? Pourquoi faire???
Exemple:
With ActiveWorkbook
.Sheets("Feuil13").Range("a1:t300").copy
.Sheets("Page 1").Range("a1").PasteSpecial xlValues
Application.CuteCopyMode = 0
End with

ActiveWorkbook.SaveAs Lechemin & NomRep & "\" & SousRep & "\" & LeFichier: à mettre avant la ligne de sauvegarde.

Application.DisplayAlerts = False - ThisWorkbook.Close SaveChanges:=True - ActiveWorkbook.Save: est à mettre avant Application.ScreenUpdating = True

Mais le mieux, c'est de mettre le fichier en PJ.

EDIT: Bonjour Jean-Claude

 

[Staple1600]

Bonjour à tous

Pour tester un code VBA, j'ajoute des MsgBox pour voir où cela peut coincer

Nom = Cells(4, 3)
MsgBox Nom ' pour test
NomClient = Cells(39, 11).Value
MsgBox NomClient ' pour test
Numimmat = Cells(15, 18).Value
MsgBox Numimmat ' pour test
NomRep = NomClient
Marque = Cells(9, 8).Value
NumParc = Cells(12, 8).Value
Jour = Format(Cells(49, 9), "dd-MM-YYYY")
MoisAN = Right(Jour, 7)
SousRep = MoisAN
MsgBox SousRep
LeFichier = Nom & " _ " & Numimmat & " _ " & NomClient & " _ " & Marque & " _ " & NumParc & " _ " & Jour
MsgBox LeFichier

Donc ajoute partout où il y a des variables, des Msgbox pour voir ce qu'elles renvoient comme valeur.

 

[Lone-wolf]

Bonjour JM

Pourquoi mettre les MsgBox, quand toutes les erreurs sautent au yeux ???

 

[Staple1600]

Bonsoir Loup Solitaire, Arpette, bonjour JCGL

Bonjour JM
Pourquoi mettre les MsgBox, quand toutes les erreurs sautent au yeux ???

parce que simplement j'espère qu'Arpette ne sera le seul à lire son fil, et que d'autres lecteurs penseront peut-être:
"Ah oui, bonne idée, si j'ai un problème avec ma macro, je testerai en mettant des MsgBox"

Puisque tu parles de sauter aux yeux, les tiens de z'yeux ne sont pas des plus efficient depuis le 1er aout 2016

Sinon le code d'Arpette ne contient pas que des erreurs, mais des syntaxes issues de l'enregistreur de macros, comme celle-ci (que tu as relévé comme une erreur qui n'en est donc pas une )
->ce code copie les cellules sur elles-mêmes en valeur seules

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Chose qu'on peut aussi écrire comme ceci

Sub ValeurSeule()
With ActiveSheet.UsedRange
.Value = .Value
End With
End Sub

 

[Arpette]

Bonsoir à vous deux,

Jean-Claude c'est une erreur de frappe, je corrige le commentaire.
Lone, tu as raison entre le moment où j'ai commencé à écrire ce code, il y a plusieurs années, il y a des choses incohérentes. Je vais reprendre tout le déroulé. Je reviens vers vous.

Merci de votre aide.

@+

 

[Staple1600]

Bonjour Arpette

Bonsoir à vous deux,

Et moi, je pue de la gu--le ?

 

[Lone-wolf]

Re JM

Je te retourne la pareil à double, si il y à des erreurs dans un code, Excel est assez grand pour te le signaler. Donc pas besoin de 50 msgbox.

Comme quoi je ne suis pas les seul au 1er rooth.

 

[Arpette]

Pardon Staple, je n'avais pas rafraichi la page. Mais comme je le dis dans mon post précédent, je vais redérouler tout le module et ton astuce de Msgbox va m'être très utile.
Merci à toi.

@+

 

[Staple1600]

Re

Loup Solitaire
Le signaler n'est pas l'expliquer sinon Arpette ne poserait pas sa question.
La question n'est pas de savoir si il y a besoin ou pas de MsgBox
Mon propos est simplement de suggérer que c'est une méthode qui peut rendre service.
Et quid de mon lien dans mon message, (cf le 1er aout) )

EDITION: Apparement Arpette est du même avis que moi

Mais comme je le dis dans mon post précédent, je vais redérouler tout le module et ton astuce de Msgbox va m'être très utile.
Merci à toi.

 

[Lone-wolf]

Re

Loin de moi à t'offenser, tu as tout mon respect. Je lui souhaite bien du courage, si en plus des messages d'Excel, elle aura aussi les MsgBox à stopper.