Résolu Passage d'excel 2003 à 2007 - macro de consolidation

  • Auteur de la discussion popeyem
  • Date de début
P

popeyem

Habitué
Salut le Forum, salut Zeb,

Comme ennoncé dans le titre, je suis passé à la super version 2007. J'ai collé ma macro dans le nouveau classeur ouvert à l'occasion et surprise , ça ne marche pas. J'ai une erreur qui vient de la méthode Range.

(précision de la macro: je souhaite copier-coller des tableaux depuis 60 fichiers d'un meme dossier/ même nom de feuille, les uns en dessous des autres tout en conservant un certain format).

Code: 
Option Explicit

Private Sub CommandButton1_Click()
Dim Chemin As String, pays_source As String, nom_pays As String
Dim cell_depart As Integer

'Trouver les fichiers du répertoire et les afficher
Chemin = ActiveWorkbook.Path
pays_source = Dir(Chemin & "\" & "* 3 YP Template to complete for 2012 2015.xlsx")

If MsgBox("Vous êtes sur le point de charger les données des pays du dossier. Continuer ?", vbYesNo) = vbYes Then
    Application.ScreenUpdating = False
    Range("A16:A65536").ClearContents

    Do While pays_source <> ""
        nom_pays = Left(pays_source, Len(pays_source) - 43)
        cell_depart = Range("A65536").End(xlUp).Row + 7
        Range(Cells(cell_depart, 4), Cells(cell_depart + 53, 30)).Consolidate "'" & Chemin & "\" & "[" & pays_source & "]P&L'!R16C5:R69C31", xlSum
        Range(Cells(cell_depart, 1), Cells(cell_depart + 71, 1)).Value = nom_pays
        pays_source = Dir()
    Loop
    
End If
Application.ScreenUpdating = True

End Sub

A vous lire!
 
zeb

zeb

Modérateur
Salut Popeyem, [:ello:]

Il y a quelques petites erreurs dans cette macro.

La fonction Dir en est une à elle toute seule. Je te propose plutôt de voir du côté de FileSystemObject. Mais passons.

Un des travers de cette fonction, c'est sa consommation excessive de ressources.
Or justement, ligne 9, tu charges le bastraingue, et ligne 11, tu demandes si on y va ou pas !

Autre chose. Tu te simplifiras la tâche à inverser tes tests.
Au lieu de penser "on continue ? Oui", pense, "on s'arrête ? non !"
Regarde :
Code: 
If MsgBox("Vous êtes sur le point de charger les données des pays du dossier. Continuer ?", vbYesNo) <> vbYes Then Exit Sub

Application.ScreenUpdating = False
Range("A16:A65536").ClearContents
...
Remarque que la question à l'utilisateur ne change pas.

Encore autre chose, tu ne précises nulle part le classeur et/ou la feuille sur laquelle tu travailles.
J'espère qu'il s'agit de la feuille en cours. Quand on jongle avec plusieurs classeurs, plusieurs feuilles, c'est une TRES bonne idée de se donner la peine de préciser sur quoi on travaille.

65536, c'est la limite des entiers 16 bits. Excel 2007 s'en affranchit. Je te propose donc de calculer la dernière ligne plutôt que de la préciser.
Code: 
' 16 bits -> Excel 2002
Range("A16:A65536").ClearContents

' toute version
Range("A16", Cells(Rows.Count, 1)).ClearContents
' Autre écriture
Range(Rows(16), Rows(Rows.Count)).Columns(1).ClearContents

Ligne 16, tu as un 43 qui traîne. Avec le x supplémentaire de l'extention Excel 2007, as-tu pensé à recalculer ce nombre ?

-----------------------

Bon, sinon il y a 4 Ranges dans ton code. Lequel pose problème ?
 
P

popeyem

Habitué
Salut Zeb, très content de te voir toujours actif dans le coin.

1ère question générale suite à mes essais: Excel plante à moitié dès que je touche au code: sur mon écran gauche je touche le code et l’écran de droite avec la feuille excel ne répond plus (même en enlevant le mode création..) une idée ?

J'ai optimisé les quelques lignes qui pouvaient l'être et précisé de quelle feuille/classeur il s'agit.
Avec le x, j'avais déjà pensé à changer la longueur. Je n'ai pas encore regardé FSO mais je suis sûr que ça doit être très sympa!

voilà mon code modifié qui plante pour le coup dès le début "Erreur de compil - Sub ou function non définie"... (J'ai changé de fichier, nouveau classeur sans definir de noms de feuilles ...)

Code: 
Option Explicit

Private Sub CommandButton1_Click()
Dim chemin As String, pays_source As String, nom_pays As String
Dim cell_depart As Integer
Dim ws_target As Worksheet

'Trouver les fichiers du répertoire et les afficher
chemin = ActiveWorkbook.Path
pays_source = Dir(chemin & "\" & "* 3 YP Template.xlsx")
Set ws_target = ActiveWorkbook.Worksheets(1)

    If MsgBox("Vous êtes sur le point de charger les données des pays du dossier. Continuer ?", vbYesNo) = vbNo Then Exit Sub
        Application.ScreenUpdating = False
        ws_target.Range("A16", Cells(Rows.Count, 1)).ClearContents
        
        Do While pays_source <> ""
            nom_pays = Left(pays_source, lenght(pays_source) - 19)
            cell_depart = ws_target.Range("A1048576").End(xlUp).Row + 7
            ws_target.Range(Cells(cell_depart, 4), Cells(cell_depart + 71, 30)).Consolidate "'" & chemin & "\" & "[" & pays_source & "]P&L'!R4C5:R75C31", xlSum
            pays_source = Dir()
        Loop
        Application.ScreenUpdating = True
    End If
End Sub

Le range qui plantait est celui de consolidation ligne 20

A te lire
 
P

popeyem

Habitué
Bon je viens de me rendre compte d'une petite erreur que j'ai corrigé ligne 13

Code: 
    If MsgBox("Vous êtes sur le point de charger les données des pays du dossier. Continuer ?", vbYesNo) = vbNo Then
    Exit Sub
    End If
Du coup plus de problème pour démarrer la macro mais pb au niveau de la ligne 11... (ça me parait être du basique, pourtant ...!)

Probleme modifié ligne 11,
Code: 
Set ws_target = ThisWorkbook.Worksheets("Feuil1")
J'en reviens donc à mon problème initial, la methode consolidate de l'objet Range ligne 20 :D
 
zeb

zeb

Modérateur
Salut :)

excel ne répond plus
Cliquez pour agrandir...
Alors arrête de jouer avec ScreenUpdating !

Le VBA est mal fini :pfff: Range() devrait se comporter comme Union() ou Intersect().
On devrait pouvoir écrire
Code: 
Range(ws_target.Cells(...), ws_target.Cells(....))......
Las, ce n'est pas le cas.
Il faut écrire
Code: 
ws_target.Range(ws_target.Cells(...), ws_target.Cells(....))......
C'est lourdingue, mais c'est comme ça :pfff:

Au lieu de ActiveWorkbook qui dépend de ce qui est actif donc, utilise ThisWokbook. Pourquoi ? Va lire l'aide d'Excel :o
(Je n'ai pas changé ;) )

Code: 
If MsgBox("blabla", vbYesNo) = vbNo Then Exit Sub
NON !!!!!!!
Code: 
If MsgBox("blabla", vbYesNo) <> vbYes Then Exit Sub
Une fenêtre ne répond pas seulement aux boutons sur lesquels tu penses que l'utilisateur va appuyer !

Code: 
cell_depart = ws_target.Range("A1048576").End(xlUp).Row + 7
Ah, cell_depart n'est pas une cellule, mais un numéro de ligne. Donc utilise un Long !

Moi, je préfère jongler avec les objets plutôt qu'avec leur coordonnées. Ça me paraît plus clair.

Code: 
Dim cell_depart As Range

Set cell_depart = ws_target.Cells(ws_target.Rows.Count, 1).End(xlUp).Offset(11)
ws_target.Range(cell_depart, cell_depart.Offset(75, 29)).Consolidate....

-----------------

Bon, tout ça c'est bien joli, mais ça ne répond pas à ton problème.
T'as pensé à faire un
Code: 
debug.print "'" & chemin & "\" & "[" & pays_source & "]P&L'!R4C5:R75C31"
pour voir si ça correspond à ce que tu veux ? (*)

Ensuite, l'as tu fais à la main et as-tu vérifié que ça fonctionnait ? (*)

____
(*) On sent un peu le mec qui ne sait pas trop quoi te dire, quand même :/
 
P

popeyem

Habitué
Bon, ça ne marche toujours pas! :??:
- corrigé pour Range
- oui j'avais remarqué et déjà changé par ThisWorkbook!
- Ok pour le if
- j'ai également testé avec ta suggestion de cell_depart
--> Il m'arrête maintenant ligne clearContent de mon code avec "methode ClearContent de la classe Range a échoué". Du propre!

le code modifié (avec mes essais ligne 17,18,19,20,21, aucun ne marche:heink:)
Code: 
Option Explicit

Private Sub CommandButton1_Click()
Dim chemin As String, pays_source As String, nom_pays As String
Dim cell_depart As Range
Dim ws_target As Worksheet

'Trouver les fichiers du répertoire et les afficher
chemin = ActiveWorkbook.Path
pays_source = Dir(chemin & "\" & "* 3 YP Template.xlsx")
Set ws_target = ThisWorkbook.Worksheets("Feuil1")

    If MsgBox("Vous êtes sur le point de charger les données des pays du dossier. Continuer ?", vbYesNo) <> vbYes Then
    Exit Sub
    End If
        
    'Application.ScreenUpdating = False
    ws_target.Range("A8:A1048576").ClearContents
    'ws_target.Range("A8", ws_target.Cells(Rows.Count, 1)).ClearContents
    'ws_target.Range(Cells(8, 1), Cells(Rows.Count, 1)).ClearContents
    'ws_target.Range(ws_target.Cells(8, 1), ws_target.Cells(Rows.Count, 1)).ClearContents
    
        Do While pays_source <> ""
            nom_pays = Left(pays_source, Len(pays_source) - 19)
            Set cell_depart = ws_target.Cells(ws_target.Rows.Count, 1).End(xlUp).Offset(1)
            'Debug.Print "'" & chemin & "\" & "[" & pays_source & "]P&L'!R4C5:R75C31"
            ws_target.Range(cell_depart, cell_depart.Offset(71, 30)).Consolidate "'" & chemin & "\" & "[" & pays_source & "]P&L'!R4C5:R75C31", xlSum
            pays_source = Dir()
        Loop
    'Application.ScreenUpdating = True

End Sub
Elle marchait parfaitement sous Excel 2003 c'te macro, avec extension du fichier bien sur en xls.. Le fait que des feuilles (des classeurs source) soient verrouillées, cela peut-il avoir un impact ?
 
zeb

zeb

Modérateur
Tu n'es pas assez lourd ! :o
Code: 
'ws_target.Range("A8", ws_target.Cells(Rows.Count, 1)).ClearContents
ws_target.Range("A8", ws_target.Cells(ws_target.Rows.Count, 1)).ClearContents

'ws_target.Range(Cells(8, 1), Cells(Rows.Count, 1)).ClearContents
'ws_target.Range(ws_target.Cells(8, 1), ws_target.Cells(Rows.Count, 1)).ClearContents
ws_target.Range(ws_target.Cells(8, 1), ws_target.Cells(ws_target.Rows.Count, 1)).ClearContents

Dans ce cas de problème, voici un petit test à faire juste avant :
Code: 
MsgBox ws_target.Range(ws_target.Cells(8, 1), ws_target.Cells(ws_target.Rows.Count, 1)).Address
ws_target.Range(ws_target.Cells(8, 1), ws_target.Cells(ws_target.Rows.Count, 1)).ClearContents
Si ça bogue :
Code: 
MsgBox ws_target.Cells(8, 1).address & " " & ws_target.Cells(ws_target.Rows.Count, 1).Address & " " & ws_target.Rows.Count & " etc." 
MsgBox ws_target.Range(ws_target.Cells(8, 1), ws_target.Cells(ws_target.Rows.Count, 1)).Address
ws_target.Range(ws_target.Cells(8, 1), ws_target.Cells(ws_target.Rows.Count, 1)).ClearContents
 
P

popeyem

Habitué
Merci, j'ai effectivement ajouté un ws_target supplémentaire et, surprise, ça marche.
Après la méthode consolidate ne marche toujours pas, du moins elle fonctionne pour le 1er pays et plante après avoir copié le nom pays et la plage de valeur spécifiée. Si je ne fais pas fonctionner la ligne 25, tout marche correctement, à savoir la copie des noms pays seulement. voir macro maj ci-dessous.

On m'a également parlé d'activer certaines références qui pouvaient ne pas l'être: aucun changement de ce côté. Je ne comprend pas !!!! :fou:
Code: 
Option Explicit

Private Sub CommandButton1_Click()
Dim chemin As String, pays_source As String, nom_pays As String
Dim cell_depart As Range
Dim ws_target As Worksheet

'Trouver les fichiers du répertoire et les afficher
chemin = ActiveWorkbook.Path
pays_source = Dir(chemin & "\" & "* 3 YP Template.xlsx")


    If MsgBox("Vous êtes sur le point de charger les données des pays du dossier. Continuer ?", vbYesNo) <> vbYes Then
    Exit Sub
    End If
        
    'Application.ScreenUpdating = False
    Set ws_target = ThisWorkbook.Worksheets(1)
    ws_target.Range("A8", ws_target.Cells(ws_target.Rows.Count, 1)).ClearContents
    
        Do While pays_source <> ""
            nom_pays = Left(pays_source, Len(pays_source) - 19)
            Set cell_depart = ws_target.Cells(ws_target.Rows.Count, 1).End(xlUp).Offset(5)
            ws_target.Range(cell_depart, cell_depart.Offset(71, 0)).Value = nom_pays
            ws_target.Range(cell_depart.Offset(0, 5), cell_depart.Offset(71, 31)).Consolidate "'" & chemin & "\" & "[" & pays_source & "]P&L'!R4C5:R75C31", xlSum
            pays_source = Dir()
        Loop
    'Application.ScreenUpdating = True

End Sub

Peut-être faut-il que je desinstalle et réinstalle office 2010 ??
 
drul

drul

Obscur pro du hardware
Staff
Salut,
As-tu essayer de faire la consolidation "à la main" depuis le menu "donnée"/"data" de excel ?
Si ça marche aide toi de l'enregisteur de macro pour voir d'ou vient l'erreur ...
 
P

popeyem

Habitué
Bonne idée. et c'est surprenant car utiliser cette commande me fait disparaitre mon excel (et pas de screenupdating dans le coup cette fois)..
 
drul

drul

Obscur pro du hardware
Staff
Essaye sur un classeur vierge, avec des données basique genre 1 2 3 4 ... pour voir si cela vient d'excel ou de ton classeur (une mise forme, ou un format mal supporté par la nouvvelle version ?)
 
P

popeyem

Habitué
Effectivement, en utilisant des nouveaux classeur, chiffres dans Feuil1 et cellules A1:A4, impossible d'ouvrir les fichiers sources pour la consolidation à la main.
 
P

popeyem

Habitué
Meilleure réponse
Ayé, je viens de trouver le problème de tous mes problèmes: En utilisant la fonction "consolidate" avec office 2003, on avait pas besoin d'ouvrir soi-même les classeurs avec les plages à consolider. (C'est d'ailleurs ce qui était intéressant en terme de temps) Maintenant, avec office2010 on est obligé d'avoir le classeur ouvert, sinon la fonction plante.

Du coup voici mon code qui marche à nouveau :D
Code: 
Option Explicit

Private Sub CommandButton1_Click()
Dim chemin As String, pays_source As String, nom_pays As String
Dim cell_depart As Range
Dim wb_source As Workbook
Dim ws_target As Worksheet

'Trouver les fichiers du répertoire et les afficher
chemin = ActiveWorkbook.Path
pays_source = Dir(chemin & "\" & "* 3 YP Template.xlsx")

Set ws_target = ThisWorkbook.Worksheets(1)

    If MsgBox("Vous êtes sur le point de charger les données des pays du dossier. Continuer ?", vbYesNo) <> vbYes Then
    Exit Sub
    End If
        
    Application.ScreenUpdating = False
    ws_target.Range("A8", ws_target.Cells(ws_target.Rows.Count, 1)).ClearContents
    
        Do While pays_source <> ""
            Set wb_source = Workbooks.Open(chemin & "\" & pays_source)
            Set cell_depart = ws_target.Cells(ws_target.Rows.Count, 1).End(xlUp).Offset(5)
            nom_pays = Left(pays_source, Len(pays_source) - 19)
            ws_target.Range(cell_depart, cell_depart.Offset(71, 30)).Consolidate "'" & chemin & "\" & "[" & pays_source & "]P&L'!R4C5:R75C30", xlSum
            ws_target.Range(cell_depart, cell_depart.Offset(71, 0)).Value = nom_pays
            wb_source.Close
            pays_source = Dir()
        Loop
        
    Application.ScreenUpdating = True

End Sub

Merci pour vos contributions !!
 
drul

drul

Obscur pro du hardware
Staff
Bravo :D

Tu peux te sélectionner comme meilleure réponse !
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Dernières actus
Derniers messages publiés
Statistiques globales
Discussions
730 129
Messages
6 717 853
Membres
1 586 373
Dernier membre
https://forum.tomshardwar
Partager cette page
Haut