XL 2010 Erreur d'execution '13' : type incompatible (Résolu)

[jeje77]

Bonsoir à tous,

J'ai un petit souci qui me fait tourner en rond depuis un certain temps, j'ai adapté une macro à mon projet VBA de mon classeur mais depuis quelques jours j'ai ce message d'erreur "Erreur d'exécution '13' : type incompatible" lorsque ma macro se lance à la fermeture du fichier.

Cela fonctionnait correctement mais ce disfonctionnement est apparu lorsque j'ai transféré mon répertoire de travail pour travailler sur clé USB.
je joint la macro avec la ligne surligné en jaune (Fic = Dir(path)) c'est la que l'erreur apparait.

Public Delai
Public Dossier
Public NbFicMax
Dim Nom
Public NextTime

Sub Sauve_Auto()
Dim strDate As String
Count = Len(ActiveWorkbook.Name)
Nom = Left(ActiveWorkbook.Name, Count - 5) & " du"
strDate = Format(Date, " dd-mmm ") & " à " & Format(Time, " h-mm-ss ")
ThisWorkbook.SaveCopyAs Filename:=Dossier & Nom & strDate & ".xlsm"
DeleteEnTrop (Dossier)
End Sub

Function GetDirectory(Optional Msg) As String
GetDirectory = "N:\Travail sur gestion Conges Immeubles\Gestion conges Pompiers\Sauvegardes\Planning"  'choix du dossier de sauvegarde
Dossier = GetDirectory & "\"
End Function

Sub ChoixNbSauvegardes()
NbFicMax = 3 'choix du nombre de sauvegardes
End Sub

Sub DeleteEnTrop(path)
Dim Fic As String
Dim Tabl() As Variant
Dim i As Integer
'Stocker les noms et les dates de sauvegarde des
'archives dans un tableau
ReDim Tabl(1, 0)
Fic = Dir(path)
Do While Fic <> ""
  ReDim Preserve Tabl(1, UBound(Tabl, 2) + 1)
  Tabl(0, UBound(Tabl, 2)) = Fic
  Tabl(1, UBound(Tabl, 2)) = FileDateTime(path & Fic)
  Fic = Dir
Loop
'S'il y a plus de fichiers que défini dans NbMax
'on trie le tableau des archives par date décroissante
'et on efface les premiers pour n'en laissser
'que le nombre choisi dans NbMax
If UBound(Tabl, 2) > NbFicMax Then
  Tri Tabl, 1, UBound(Tabl, 2)
  For i = UBound(Tabl, 2) To NbFicMax + 1 Step -1
   Kill path & Tabl(0, i)
  Next i
End If
End Sub

'Procédure récursive classique
'de tri adaptée au tri d'un
'tableau à 2 dimensions
Sub Tri(ByRef Liste As Variant, ByVal Bas As Long, ByVal Haut As Long)
Dim i  As Long, j As Long
Dim Milieu As Variant, Echange As Variant
  i = Bas
  j = Haut
  Milieu = Liste(1, Int(Bas + Haut) / 2)
  Do
    While Liste(1, i) > Milieu
      i = i + 1
    Wend
    While Milieu > Liste(1, j)
      j = j - 1
    Wend
    If i <= j Then
      Echange = Liste(1, i)
      Liste(1, i) = Liste(1, j)
      Liste(1, j) = Echange
      Echange = Liste(0, i)
      Liste(0, i) = Liste(0, j)
      Liste(0, j) = Echange
      i = i + 1
      j = j - 1
    End If
  Loop Until i > j
  If Bas < j Then Tri Liste, Bas, j
  If i < Haut Then Tri Liste, i, Haut
End Sub

Si quelqu'un pouvais m'aider à comprendre ce probleme ce serait cool
Par avance merci
Cordialement jeje77

 

[jeje77]

je me suis apercu que le fichier s'enregistre automatiquement dans le repertoire "mes documents" sans savoir pourquoi !!!

 

[Bernard_XLD]

Bonjour

sans fichier et sur la seule indication du code, je dirai que le problème vient de cette ligne
GetDirectory = "N:\Travail sur gestion Conges Immeubles\Gestion conges Pompiers\Sauvegardes\Planning"
si tu travailles avec une clef usb sur un autre ordi, il faut que tu reprécises un répertoire de sauvegarde existant ou que tu reconnectes la ressource concernée
si le répertoire de sauvegarde est sur ta clef usb comme ton fichier, tu peux modifier la ligne de code pour récupérer la bonne lettre de lecteur pour la clef, elle change en fonction des ressources existantes sur les ordis et prend généralement la première lettre disponible
GetDirectory = Left(ThisWorkbook.path, 1) & ":\Travail sur gestion Conges Immeubles\Gestion conges Pompiers\Sauvegardes\Planning" 'choix du dossier de sauvegarde

Cordialement

 

[jeje77]

Bonjour,
Merci de vous pencher sur mon cas .
je viens de changer la ligne du code mais rien ne change pour l'enregistrement, mais je n'ai plus d'erreur "13"
Je joint le fichier en exemple

 

[Bernard_XLD]

Re
Ce code n'a jamais pu fonctionner en l'état et le simple transfert du fichier sur une clef ne peut l'expliquer
la fonction GetDirectory n'est jamais appelée ce qui fait de la variable dossier une chaine vide donc un enregistrement sous le répertoire actif par défaut
la sub ChoixNbSauvegardes n'est jamais appelée ce qui fait que NbFicMax reste à 0 et que tous les fichiers sauvegardés sont directement effacés
voila tes deux macros modifiées

Sub Sauve_Auto()
Dim strDate As String

Dossier = Left(ThisWorkbook.path, 1) & ":\Travail sur gestion Conges Immeubles\Gestion conges Pompiers\Sauvegardes\Planning\"

Count = Len(ActiveWorkbook.Name)
Nom = Left(ActiveWorkbook.Name, Count - 5) & " du"
strDate = Format(Date, " dd-mmm ") & " à " & Format(Time, " h-mm-ss ")
ThisWorkbook.SaveCopyAs Filename:=Dossier & Nom & strDate & ".xlsm"
DeleteEnTrop (Dossier)
End Sub
Sub DeleteEnTrop(path)

NbFicMax = 3 'choix du nombre de sauvegardes

Dim Fic As String
Dim Tabl() As Variant
Dim i As Integer
'Stocker les noms et les dates de sauvegarde des
'archives dans un tableau
ReDim Tabl(1, 0)
Fic = Dir(path)
Do While Fic <> ""
  ReDim Preserve Tabl(1, UBound(Tabl, 2) + 1)
  Tabl(0, UBound(Tabl, 2)) = Fic
  Tabl(1, UBound(Tabl, 2)) = FileDateTime(path & Fic)
  Fic = Dir
Loop
'S'il y a plus de fichiers que défini dans NbMax
'on trie le tableau des archives par date décroissante
'et on efface les premiers pour n'en laissser
'que le nombre choisi dans NbMax
If UBound(Tabl, 2) > NbFicMax Then
  Tri Tabl, 1, UBound(Tabl, 2)
  For i = UBound(Tabl, 2) To NbFicMax + 1 Step -1
   Kill path & Tabl(0, i)
  Next i
End If
End Sub

 

[jeje77]

Merci pour votre aide Yeaou,

Ce code fonctionne bien mais si j'efface mon ancien module avec mon ancienne macro cela ne fonctionne plus il m'ouvre un message d'erreur au niveau de la ligne "tri" me disant :
"Erreur de compilation Sub ou Fonction non definie"
J'ai ajouté ( Dim count As String, nom As String ) sous la ligne ( Dim strDate As String )
Si j'importe à nouveau l'ancien code la fermeture du fichier se fait normale ment et je trouve bien mais 3 fichiers maxi dans le repertoire.

 

[Bernard_XLD]

Il fallait simplement remplacer les deux macros concernées sans supprimer la sub tri
voila ton fichier modifié

 

[jeje77]

Je vous remercie cela fonctionne parfaitement

Cordialement
jeje77

 

[jeje77]

Super !!!
Je vous remercie pour l'attention que vous avez porté à mon probleme
Le fichier fonctionne comme je le souhaitais.

Je vous souhaite à tous une bonne soirée.

Cordialement
jeje77