Discussion :

[Polygos]

Bonjour les amis, je pensais savoir faire une question aussi simple, visiblement non.
Je fais une copie en automatique d'une base de donnée sur un tableau excel vers un autre tableau excel et je procède logiquement comme ceci:
Itération sur les colonnes, puis sur les lignes
contrôle que la cellule n'est pas vide, sinon je saute
copie de la cellule du fichier origine de la feuille concernée de wbk2 vers celle de wbk2, classeurs définis sur mon réseau.
Premier souci.

Cette copie sert à mettre à jour des données dedans, puis sera ensuite recopiée, dans la base d'origine qui évolue ainisi, uniquement si des cellules sont modifiées (mises en rouge).
Il s'agit d'une base d'articles assez lourde, 125 colonnes et 1617 lignes (extensible à davantage à l'avenir) qui comporte des descriptions de produits en plusieurs langues; aussi faut il souvent mettre à jour et jugeant que c'est dangereux de faire les modifs dans la base elle-même et afin de s'y retrouver, je préfère faire une copie, la modifier, puis réinjecter les modifs dans la base initiale.
voila pour l'explication de la logique.

Lorsque la copie est faite, le traducteur intervient et, à l'aide d'une Private sub worksheet_change, toutes les cellules "touchées" passent en gras rouge:

Code :

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

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
With Selection.Offset(-1, 0).Font
.ColorIndex = 3
.Bold = True
End With
End Sub

Cette procéure est placée au niveau de la feuille concernée. elle fonctionne sauf pour la dernière ligne; si je ne mets pas l'offset, elle ne fonctionne pas pour la première, détail pas compris.

Le second problème, c'est qu'il faudrait "arrêter cette routine" le temps de la copie, sinon bien sûr, elle est "rouge" !
Ce que j'ai fait en la desactivant au début du run de la procédure de copie et en la réactivant après.
Mais ça ne fonctionen pas, elle reste rouge, cette copie.
Second souci donc.

Maintenant que vos avez les explications, vous allez me montrer ou j'ai pêché....

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
28
29
30
31
32
33
34
Sub rafraichir()
'RAFRAICHI LA COPIE DE GRANDE BASE - MODULE 7
Dim wbk1 As Workbook
Dim wbk2 As Workbook
 
Set wbk1 = ThisWorkbook
Set wbk2 = Workbooks.Open(Filename:="C:\Users\Christophe\Documents\PHOTOS & FT FOURNISSEURS\..CATALOGUE\CATALOGUE KZ\GRANDE BASE 1108O1108.xlsm")
 
Dim l As Integer
Dim c As Integer
 
' Désactivation de la macro évènement
Application.EnableEvents = False
 
 
If MsgBox("Voulez-vous mettre à jour la copie avec le contenu réel de la base article ?", vbYesNo, "Confirmation de la demande") = vbYes Then
 
    For c = 1 To 125
        For l = 8 To 1617
            If wbk2.Worksheets("Epicerie").cells(l, c) <> "" Then
 
            wbk1.Worksheets("Epicerie").cells(l, c) = wbk2.Worksheets("Epicerie").cells(l, c)
            Else
            End If
        Next l
    Next c
 
 
Else
End If
' Réactivation de la macro évènement
Application.EnableEvents = True
 
End Sub

Ce module est placé au niveau du classeur.

Alors,
1/Comment faire pour l'accélérer ? 10 minutes de calcul actuellement.
A noter que j'avais mis une condition de cellule vide non copiée pour gagner du temps...

2/Comment neutraliser la procédure worksheet_change ?

a la fin, j'ai essayé autre chose: laisser la worksheet_change fonctionner et TOUT repasser en noir en fin du programme de copie:

Code :

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

1
2
3
4
'Remise en noir
wbk1.Range("A8:DP1617").Select
Selection.ColorIndex = 1
Selection.Bold = False

Mais je vois bien que c'est lourd...
Je pense que je vais prendre une claque, non ?

[halaster08]

Alors,
1/Comment faire pour l'accélérer ? 10 minutes de calcul actuellement.
A noter que j'avais mis une condition de cellule vide non copiée pour gagner du temps...

Copier la plage entière et pas cellule par cellule.

2/Comment neutraliser la procédure worksheet_change ?

il me semble que c'est:

Code :

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

application.enableevents=false

A reppasser en true quand tu as fini.

[Polygos]

Bonjour halaster08 et merci de ton retour.

J'avais pensé copier la plage mais lors de la seconde phase du programme qui va être de reprendre uniquement ce qui a été porté en rouge dans le fichier dr'origine, il va bien falloir que je copie cellule après cellule, avec test sur le couleur pour prendre en compte ou non la modif....

La position de la procédure worksheet_change est bien correcte ?

Par ailleurs, pourquoi ai je un décalage dans la mise en rouge, avec ou sans offset de ligne ?

Je suis nouveau, je n'ai as trouvé ou obtenir des fenêtre dans le message comme vous faites pour montrer le code; c'est où ?

[patricktoulon]

bonjour

je récapitule:
tu a une base et une copie de la base

tu met plusieurs fois ta copie base a jour en fonction de la base(quotidiennement ,ponctuellement ,etc....)

tu ne modifie que les cellules qui sont différentes c'est bien ca?

dans ce cas si ta copie base doit être identique a la base
pourquoi ne pas copier directement toute la plage de la base sur la copie en une fois

Code :

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

wbk1.range(cells(8,1),cells(1627,125))=wbk2.range(cells(8,1),cells(1627,125))

pas besoins de tester

[halaster08]

Je suis nouveau, je n'ai as trouvé ou obtenir des fenêtre dans le message comme vous faites pour montrer le code; c'est où ?

C'est la balise code, symbole #
Ca rend le code beaucoup plus et j'aurais d'ailleurs vu que tu utilise déjà application.enableevents

La position de la procédure worksheet_change est bien correcte ?

il me semble que oui, as tu consulté le tuto sur les évènements du classeur? si non je te le conseille.

Par ailleurs, pourquoi ai je un décalage dans la mise en rouge, avec ou sans offset de ligne ?

Je ne sais pas. Si tu fais des changement "à la main" (sans macro) que se passe-t-il?

[Polygos]

Bonjour Patrick,
oui c'est logique; mon souci peut être résolu mais quand je vais devoir refaire les copies dans l'autre sens, là, je ne couperais pas à la copie sur test de couleur, car je ne veux reintéger dans la base QUE les modifications.
alors tu préconises aussi une copie globale ?

J'ai modifié le code avec la copie globale, comme indiqué et j'obtiens un arrêt sur la ligne que tu m'as donnée (erreur 438 ci-dessous, en bas je sais pas pourquoi ça sort pas là ou je l'ai mis sur cette page !) :


Merci Halaster pour la balise, je vais tester

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
' Désactivation de la macro évènement
Application.EnableEvents = False
 
 
If MsgBox("Voulez-vous mettre à jour la copie avec le contenu réel de la base article ?", vbYesNo, "Confirmation de la demande") = vbYes Then
 
wbk1.Range(cells(8, 1), cells(1627, 125)) = wbk2.Range(cells(8, 1), cells(1627, 125))
 
Else
End If
' Réactivation de la macro évènement
Application.EnableEvents = True

Pour le test copie à la main, ça marche pour la première ET pour la dernière ligne..vraiment étrange
Mais alors pourquoi mon activation / désactivation en debut et fin de procédure ne fonctionne pas ?

[halaster08]

Code :

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

wbk1.Range

Renvoie une erreur.
Il faut écrire

Code :

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

wbk1.sheets().range

Mais alors pourquoi mon activation / désactivation en debut et fin de procédure ne fonctionne pas ?

Lance la macro en mode pas à pas (F8) tu verras peut être mieux ce qu'il se passe

[Docmarti]

Bonjour.

Fais une seule écriture au lieu de 100 ou 1000.
Essaie ceci :

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
28
29
30
Sub CopierBaseVersThisWorkBook()
 
Set Destination = ThisWorkbook.Worksheets("Epicerie")
 
 
fich = "C:\Users\Christophe\Documents\PHOTOS & FT FOURNISSEURS\..CATALOGUE\CATALOGUE KZ\GRANDE BASE 1101108.xlsm"
 
Set wb = Workbooks.Open(Filename:=fich, local:=True)
 
Set origine = wb.Worksheets("Epicerie")
 
 
lignes = 1617
colonnes = 125
 
Call Copier(origine, lignes, colonnes, Destination)
 
wb.Close False
 
End Sub
 
Sub Copier(origine, lignes, colonnes, Destination)
 
Destination.Cells.Clear
 
Set ori = origine.Range(origine.Cells(1, 1), origine.Cells(lignes, colonnes))
 
ori.Copy Destination.Cells(1, 1)
 
End Sub

[Papytrick]

Bonjour,

Je ne suis pas une vraie référence pour les conseils
Mais je me propose de répondre à une de tes interrogations (si j'ai bien compris ton tracas). Lorsque tu utilises l'Event Worksheet_Change pourquoi ne pas utiliser directement le range appelé Target?

Ancien code:

Code :

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

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
 With Selection.Offset(-1, 0).Font
    .ColorIndex = 3
    .Bold = True
 End With
 End Sub

Et je te propose:

Code :

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

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
 With Target.Font
    .ColorIndex = 3
    .Bold = True
 End With
 End Sub

Je ne suis pas sûr que cela répond à ce qui te chagrine, mais cela se pourrait.

[patricktoulon]

re
oui autant pour moi il faut préciser le sheets
wbk2.sheets(.....).range(....) et pareil pour wbk1

[eriiic]

Bonjour,

Code :

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

1
2
' Désactivation de la macro évènement
Application.EnableEvents = False

Tu viens d'ouvrir wbk2 qui est actif.
Quelle version d'excel ? C'est bien sur celui-ci que tu dois désactiver les événements ? Sur 2013 qui ne gère pas pareil les classeurs ça pose peut-être des problèmes.
Bien que non sur ce point en théorie :
With the shift to SDI, all of the Excel application-level window methods, events, and properties remain unaffected and work the way they have in previous versions of Excel
eric

[Polygos]

Merci de vos retours et voyons si on avance:

J'ai effectivement modifé la copie avec .sheets("Epicerie") puisqu'il s'agit des noms des feuilles:

Code :

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

wbk1.Sheets("Epicerie").Range(cells(8, 1), cells(1627, 125)) = wbk2.Sheets("Epicerie").Range(cells(8, 1), cells(1627, 125))

plantage au même endroit, message d'erreur 1004 erreur définie par l'application ou par l'objet..
bon. Kesako?
A noter au passage que je devrais changer la ligne 1627 par un xlend, à voir comment l'écrire pourne pas se tromper.

Pour docmarti, j'avoue que je n'ai pas tout compris mais ça parait plus simple; mais surtout ce que je souhaite c'est une formulation qui me permettra de faire le remplacement des données en sens inverse, quand elles auront été modifiée dans la copie et qu'il faudra ne remplacer ans l'original QUE les données en rouge (test sur la couleur de la police et copie une à une): d'où mon souhait de conserver uine formulation qui permette cette copie "une à une", puisque seules les cellules modifiées par le private sur worksheet_change seront concernées.

Enfin, pour Papytrick, même effet. la dernière ligne reste noire...

Point mort pour l'instant...

[Polygos]

Bonjour,

Code :

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

1
2
' Désactivation de la macro évènement
Application.EnableEvents = False

Tu viens d'ouvrir wbk2 qui est actif.
Quelle version d'excel ? C'est bien sur celui-ci que tu dois désactiver les événements ? Sur 2013 qui ne gère pas pareil les classeurs ça pose peut-être des problèmes.
Bien que non sur ce point en théorie :
With the shift to SDI, all of the Excel application-level window methods, events, and properties remain unaffected and work the way they have in previous versions of Excel
eric

Que veux tu dire par "tu viens d'ouvrir wbk2 qui est actif ? quelle incidence ?
Je suis sur Excel 2013
..
et comme tu l'as vu sur ma précédente réponse, il y a encore une erreur à ma tentattive de remettre tout en noir après la routine worksheet_change.

Code :

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

1
2
3
wbk1.Worksheets("Epicerie").Range("A8:DP1617").Select
Selection.ColorIndex = 1
Selection.Bold = False

[Polygos]

J'ai essayé de bidouiller une remise au noir des entrée malencontreusement "rougies" par ma procédure worksheets_change avec ça:

Code :

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

1
2
3
wbk1.Worksheets("Epicerie").Range("A8:DP1686").Select
Selection.ColorIndex = 1
Selection.Bold = False

Mais j'y vois encore une erreur 438: propriété ou méthode non gérée par cet objet.

Code :

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

1
2
3
4
5
6
Sub mise_au_noir()
Set wbk1 = ThisWorkbook
wbk1.Worksheets("Epicerie").Range("A8:DP1686").Select
Selection.ColorIndex = 1
Selection.Bold = False
End Sub

Qu'ai je fait comme erreur de syntaxe ? (entre temps 1617 est devenu 1686, normal; je devrais y mettre xlend mais je sais pas trop comment faire)

Merci en tous cas à vous pour cet échange ou je vois que ce n'est pas si évident pour un pb qui me paraissait pas trop coimpliqué; comme quoi !

[eriiic]

Bonjour,

Que veux tu dire par "tu viens d'ouvrir wbk2 qui est actif ? quelle incidence ?

Excel 2013 gère les classeurs dans des instances séparées.
En théorie Application est commun mais dans le doute teste en mettant .EnabledEvents =False lorsque le classeur concerné est actif pour voir si ça règle ce pb de non désactivation.
Ca ne serait pas illogique qu'ils aient attribué à chaque instance son propre paramètre et expliquerait cette anomalie.
eric

[Docmarti]

Bonjour.

Pour retrouver derniere ligne et derniere colonne.

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
28
29
30
31
32
33
34
35
36
Sub test()
 
'Retrouver derniere ligne dans la colonne "A"
Set f = Worksheets(1)
dern = f.Cells(Rows.Count, "A").End(xlUp).Row
MsgBox dern
 
'Derniere ligne et derniere colonne d'une feuille ou d'une plage
Set UnePlage = f.Cells 'Une feuille
Set UnePlage = f.Range("A3:d20") 'Une plage
Set UnePlage = f.Columns(1) 'Une colonne
 
Call TrouverDernieres(DerniereLigne, derniereColonne, UnePlage)
 
f.Cells(DerniereLigne, derniereColonne).Select
 
MsgBox f.Cells(DerniereLigne, derniereColonne).Address
 
End Sub
 
Function TrouverDernieres(DerniereLigne, derniereColonne, UnePlage)
 
With UnePlage
 
 DerniereLigne = UnePlage.Row
 derniereColonne = UnePlage.Column
 
 Set Resultat = .Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchFormat:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
 If Not Resultat Is Nothing Then DerniereLigne = Resultat.Row
 
 Set Resultat = .Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchFormat:=False, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
 If Not Resultat Is Nothing Then derniereColonne = Resultat.Column
 
End With
 
End Function

Code :

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

Selection.ColorIndex = 1

ColorIndex s'applique a Interior

Code :

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

Selection.Interior.ColorIndex = 1

[Polygos]

Malheureusement, ça ne mache pas;
j'ai conservé devant :

Code :

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

wbk1.Worksheets("Epicerie").Range("A8:DP1747").Select

et c'est là que le programme s'arrête maintenant...une idée ?

[AlainTech]

Bonjour,

...une idée ?

Oui. Pourquoi un Select?

[Invité]

Bonjour,
regarde du coté des filtres élaboré! le résultat est quasi instantané!

http://philippetulliez.developpez.co...dvancedfilter/