VBA - 13 type Incompatibilité

Le 02/05/2017 à 20:13

Bonjour à tous !

Aujourd'hui je fais face à un problème VBA qui m'embête bien car ma macro ne fonctionne pas. L'objectif de ma macro est de prendre des données dans une liste de fichiers excels qui sont regroupés dans un même répertoire. Donc je vise ce répertoire, je récupère les données qui m'intéressent dans chaque fichier, et je les place au bon endroit sur un seul fichier excel récapitulatif.

Le message d'erreur qui s'affiche est : " 13 type incompatibilité". Ci-dessous, ma macro avec en jaune la partie surlignée en jaune lorsque je fais debogage.

Sub Consolider_Click()

Dim S_Commande As Worksheet

Dim Chemin As String

Dim Extension As String

Dim Nb As Integer

Set S_Commande = ThisWorkbook.Sheets("Commande")

Chemin = S_Commande.Cells(3, 2).Value

Extension = S_Commande.Cells(4, 2).Value

Nb = BoucleFichiers(Chemin, Extension)

MsgBox ("Nombre de lignes remplies : " & Nb)

End Sub

Function BoucleFichiers(Chemin As String, Extension As String) As Integer

Dim Fichier As String

BoucleFichiers = 0

'Boucle sur tous les fichiers 'Extension' du répertoire 'Chemin'

Fichier = Dir(Chemin & "*" & Extension)

Do While Len(Fichier) > 0

'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).

BoucleFichiers = BoucleFichiers + ChargerFichier(Chemin & Fichier)

'MsgBox (Chemin & Fichier) '<-- A modifier

Fichier = Dir()

Loop

End Function

Function ChargerFichier(NomFichier As String) As Integer

Dim WB_Fichier As Workbook

Dim Liste As Worksheet

Dim Fin As Boolean

Dim trouve As Boolean

Dim i As Integer

Dim Temp As Integer

Set WB_Fichier = Workbooks.Open(NomFichier)

Set Liste = WB_Fichier.Sheets("Liste complète")

Fin = False

trouve = False

i = 5

ChargerFichier = 0

While Not Fin

'Si le contenu de la cellule(i,2) est vide alors Fin = True et fin de la boucle While. Sinon: si le contenu de la cellule(i,13) n'est pas vide alors trouve = True

If (Trim(Liste.Cells(i, 2).Value) = "") Then

Fin = True

Else

If (Trim(Liste.Cells(i, 122).Value) <> "" Or Trim(Liste.Cells(i, 123).Value) <> "") Then

trouve = True

End If

End If

'Si trouve = True, Temp prend la valeur renvoyée par la fonction ChargeDonnees évaluée en ... et ChargerFichier s'incrémente de la valeur de Temp

If (trouve) Then

Temp = ChargeDonnees(Trim(Liste.Cells(i, 2).Value), Trim(Liste.Cells(i, 3).Value), Trim(Liste.Cells(i, 4).Value), Trim(Liste.Cells(i, 5).Value), Trim(Liste.Cells(i, 6).Value), Trim(Liste.Cells(i, 7).Value), Trim(Liste.Cells(i, 8).Value), Trim(Liste.Cells(i, 9).Value), Trim(Liste.Cells(i, 10).Value), Trim(Liste.Cells(i, 11).Value), Liste.Cells(i, 122).Value, Liste.Cells(i, 123).Value, Liste.Cells(i, 124).Value, Liste.Cells(i, 125).Value, Liste.Cells(i, 130).Value, Liste.Cells(i, 131).Value, Liste.Cells(i, 132).Value, Liste.Cells(i, 137).Value, Liste.Cells(i, 138).Value, Liste.Cells(i, 139).Value, Liste.Cells(i, 140).Value, Liste.Cells(i, 145).Value, Liste.Cells(i, 146).Value, Liste.Cells(i, 147).Value, Liste.Cells(i, 148).Value)

ChargerFichier = ChargerFichier + Temp

trouve = False

End If

i = i + 1

Wend

WB_Fichier.Close savechanges:=False

End Function

Function ChargeDonnees(company As String, BL As String, BU As String, CP As String, PM As String, SPM As String, Client As String, Account As String, NomProjet As String, ADM As String, Montant As Double, CaextPTD As Double, CoutsPTD As Double, ImputationPTD As Integer, CaextYTD As Double, CoutsYTD As Double, ImputationYTD As Integer, CaextMTD As Double, CommentaireMTD As String, CoutsMTD As Double, ImputationMTD As Integer, Fiab_Chiffres As String, Fiab_Outils As String, Besoin_Outils As String, Besoin_Hermes As String) As Integer

Dim S_Liste As Worksheet

Set S_Liste = ThisWorkbook.Sheets("Liste complète")

Fin = False

trouve = False

i = 5

While Not Fin

If (Trim(S_Liste.Cells(i, 2).Value) = "") Then

Fin = True

Else

If (Trim(S_Liste.Cells(i, 2).Value) = company) Then

If (Trim(S_Liste.Cells(i, 3).Value) = BL) Then

If (Trim(S_Liste.Cells(i, 4).Value) = BU) Then

If (Trim(S_Liste.Cells(i, 5).Value) = CP) Then

If (Trim(S_Liste.Cells(i, 6).Value) = PM) Then

If (Trim(S_Liste.Cells(i, 7).Value) = SPM) Then

If (Trim(S_Liste.Cells(i, 8).Value) = Client) Then

If (Trim(S_Liste.Cells(i, 9).Value) = Account) Then

If (Trim(S_Liste.Cells(i, 10).Value) = NomProjet) Then

If (Trim(S_Liste.Cells(i, 11).Value) = ADM) Then

S_Liste.Cells(i, 122).Value = Montant

S_Liste.Cells(i, 123).Value = CaextPTD

S_Liste.Cells(i, 124).Value = CoutsPTD

S_Liste.Cells(i, 125).Value = ImputationPTD

S_Liste.Cells(i, 130).Value = CaextYTD

S_Liste.Cells(i, 131).Value = CoutsYTD

S_Liste.Cells(i, 132).Value = ImputationYTD

S_Liste.Cells(i, 137).Value = CaextMTD

S_Liste.Cells(i, 138).Value = CommentaireMTD

S_Liste.Cells(i, 139).Value = CoutsMTD

S_Liste.Cells(i, 140).Value = ImputationMTD

S_Liste.Cells(i, 145).Value = Fiab_Chiffres

S_Liste.Cells(i, 146).Value = Fiab_Outils

S_Liste.Cells(i, 147).Value = Besoin_Outils

S_Liste.Cells(i, 148).Value = Besoin_Hermes

trouve = True

End If

End If

End If

End If

End If

End If

End If

End If

End If

End If

End If

End If

If (trouve) Then

Fin = True

End If

i = i + 1

Wend

If (trouve) Then

ChargeDonnees = 1

Else

ChargeDonnees = 0

End If

End Function

Je ne peux malheureusement pas vous joindre mon fichier excel... Si cela est trop compliqué comme cela je comprendrais sans problème. Merci à ceux qui me liront dans l'objectif de m'aider. Je vous souhaite une bonne soirée !

SkillzZ

Le 02/05/2017 à 20:35

Bonsoir,

Sans regarder plus, commence déjà par incrémenter ton code (il y a déjà un "End if" de trop). tu l'aurais vu si le code était incrementé

Vérifie tes variables "Integer" qui sont peut être mal adapté (voir Long ou double) n'ayant aucune base au départ

Lance ta procèdure avec la touche F8 (en pas à pas) et avec deux ou trois indices espions tu trouveras le "BIN'S"

Et place ton code entre balises CODE (une p'tite case verte à cliquer)

Le 03/05/2017 à 08:48

Merci pour tous ces conseils, j'ai résolu mon problème, je visais la mauvaise cellule... Je ne sais pas ce que veulent dire les conseils que tu m'as donné mais je vais chercher sur internet pour les mettre en place s'ils m'aident ! Merci !

Le 03/05/2017 à 10:03

J'aimerais vous poser dernière question par rapport à ce code avant de clore le sujet.

Ce code comme je l'ai dit, me permet de prendre des données dans différents fichiers excel (qui ont la même forme mais dont les cases remplies diffèrent), et de les placer au bon endroit dans un unique fichier excel global. Le souci est qu'il récupère à chaque fois tous les contenus de cellule (même si elles sont vides!) dans chacun des fichiers ce qui fait qu'il écrase les données qui ont été prises dans les fichiers précédents.

J'aimerais que mon code copie uniquement les cellules dont le contenu est non vide. Peut être que le problème est du au format des cellules du fichier global ou des fichiers que je vise ?

Je vous souhaite une bonne journée,

SkillzZ

Le 03/05/2017 à 10:13

Bonjour à tous,

J'ai une petite question ! Voilà tout d'abord je ne suis pas expert en Excel mais je ne me débrouille pas trop mal. J'ai réalisé une base de donnée clients avec différents critères principaux et à l'intérieur de ces critères des sous critères en colonnes (j'espère que je suis assez clair ). Je souhaite pouvoir filtrer par critères principaux et que par personnes cela me sorte l'ensemble les sous catégories de ce critère.

J'espère que mes explications sont compréhensibles.

Je vous remercie par avance de l'aide que vous pourrez m'apporter.

Bonne Journée

Le 03/05/2017 à 10:20

@Hlyna

Merci d'ouvrir un nouveau message avec ton problème et de ne pas venir interférer avec ce sujet de SkillzZ.

Le 03/05/2017 à 10:21

Ah pardon .... Je change alors !

Encore désolé.

Ah pardon ... Je change alors !

Encore désolé.

Le 03/05/2017 à 11:47

Bonjour SkillzZ,

Sans fichier de travail, pas très facile de mettre en place

Rechercher des sujets similaires à "vba type incompatibilite"