macro qui fait trembler ma feuille de calcul

**mobiclick** · 06/09/2010, 11h21

Bonjour le forum,

Merci à toute la communauté pour le travail remarquable

Mon problème est le suivant:

J'ai détecté une macro qui fait trembler mon tableau excel 2007 lorsque j'utilise les touches de directions ,car en supprimant la macro en question mon tableau redevient normal.Je crois que le code n'est pas optimisé.Le voici:

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
For Each Cell In Range("K11:K52")
    If Cell = "" Then
        Cell.Offset(0, 2) = ""
    End If
Next
For Each Cell In Range("O11:O52")
    If Cell = "" Then
        Cell.Offset(0, 2) = ""
    End If
Next
For Each Cell In Range("T11:T52")
    If Cell = "" Then
        Cell.Offset(0, 2) = ""
    End If
Next
For Each Cell In Range("Z13:Z51")
    If Cell = "" Then
        Cell.Offset(0, 3) = ""
    End If
Next
For Each Cell In Range("AK16:AK30,AT16:AT30,BC16:BC30,BL16:BL30,BU16:BU30,CD16:CD30")
    If Cell = "" Then
        Cell.Offset(0, 2) = ""
    End If
Next
 
End Sub

Merci d'avance

**Gord21** · 06/09/2010, 12h50

Bonjour,
Au début de ta procédure, tu peux ajouter :

Code :

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

Application.ScreenUpdating = False

ce qui a pour effet de geler la mise à jour de l'écran pendant le déroulement de ta macro.
Juste avant le End Sub, tu réactives avec

Code :

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

Application.ScreenUpdating = True

@+

**mobiclick** · 09/09/2010, 09h35

Bonjour le forum,
Merci Gord21 mais j'ai déjà essayé le ScreenUpdating sans succès ...je ne sais pas pourquoi mais l'écran scintille tjrs!! Peut-être qu'une modification de la macro en question donnera quelquechose ?
merci

**mercatog** · 09/09/2010, 13h32

étrange emplacement du code
à chaque sélection d'une cellule, le code est exécuté? dans quel but?

**Yoyo57** · 09/09/2010, 14h13

Bonjour mobiclick, bonjour tout le monde,

Comme l'a bien dit mercatog, il est étonnant que tu veuilles exécuter ton code à chaque changement de cellule. C'est ce qui provoque le scintillement.

Je pense que tu devrais faire un test sur Target et n'exécuter ce code que pour certaines valeurs particulières de Target.

Si ton besoin est réellement d'exécuter ce code à chaque fois, je pense que la solution de Gord21 est pertinente. Je te propose d'ajouter :

Code :

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

1
2
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

au début du code et

Code :

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

1
2
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

à la fin du code.

**babaothe** · 09/09/2010, 14h41

salut

en plus de la remarque judicieuse faite par mercatog quant à la l'utilité de ne provoquer le déclenchement de ces boucles que lorsque nécessaire :
- Je dirais que tes "tremblements" visuels sont ceux de ton curseur et non ceux de ta feuille..
- je cacherais alors (y compris avec ton code, tel qu'il est) le curseur pendant les boucles et le remontrerais à la fin, ainsi :

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
 
' a mettre dans la partie générale de ton module
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
 
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 ShowCursor 0
 ScreenUpdating = False
  For Each Cell In Range("K11:K52")
    If Cell = "" Then
        Cell.Offset(0, 2) = ""
    End If
  Next
  For Each Cell In Range("O11:O52")
    If Cell = "" Then
        Cell.Offset(0, 2) = ""
    End If
  Next
  For Each Cell In Range("T11:T52")
    If Cell = "" Then
        Cell.Offset(0, 2) = ""
    End If
  Next
  For Each Cell In Range("Z13:Z51")
    If Cell = "" Then
        Cell.Offset(0, 3) = ""
    End If
  Next
  For Each Cell In Range("AK16:AK30,AT16:AT30,BC16:BC30,BL16:BL30,BU16:BU30,CD16:CD30")
    If Cell = "" Then
        Cell.Offset(0, 2) = ""
    End If
  Next
 ShowCursor 1
 ScreenUpdating = True
End Sub

**Pierre Fauconnier** · 09/09/2010, 17h05

Pour compléter Babaothe

Ne pas oublier Application. devant ScreenUpdating

Pour éviter la perte du curseur en cas d'erreur dans la macro, il est préférable de gérer les erreurs éventuelles

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub test()
  On Error GoTo Fin
 
  ShowCursor 0
  Application.ScreenUpdating = False
  ...
  ...
Fin:
  ShowCursor 1
  Application.ScreenUpdating = True
End Sub

[EDIT]Code corrigé suite à la remarque de babaothe. Merci [/EDIT]

**babaothe** · 09/09/2010, 17h20

Excellente idée de Pierre Fauconnier.
C'est plus prudent

Attention toutefois à mettre le premier ShowCursor à 0 et non 1

**mobiclick** · 09/09/2010, 18h20

Bonjour à tous,
Et merci d'avoir répondu
Mercatog a tout à fait raison

étrange emplacement du code
à chaque sélection d'une cellule, le code est exécuté? dans quel but?

je ne m'y connais pas trop en macros vba mais tout ce que je cherche c'est que lorsqu'une cellule de la plage K11:K52 EST VIDE et bien le contenu de la cellule qui se trouve à 2 colonnes à droite s'effacera automatiquement.Même choses pour les autres plages de cellules.Je cherche une alternative à mon code.
Merci

**babaothe** · 09/09/2010, 18h28

re salut
s'il s'agit d'un fichier à "corriger" (déjà rempli, donc) lance tes boucles comme montré une seule fois, dans l'évènement Activate de ta feuille, par exemple.
Ensuite, c'est au moment où tu remplis les cellules concernées (juste en les quittant) qu'il te suffit de les remettre à "", si elles doivent être à "", c'est tout.

**mobiclick** · 09/09/2010, 18h45

C'est très cool mais seulement je ne sais pas le faire...un peu de ton temps s'il te plais...promis que je vais me pencher sérieusement sur la question une fois la solution trouvée...c'est un fichier qui urge...
merci

**mercatog** · 09/09/2010, 18h46

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
Sub Mobi(ByVal Target As Range)
Dim plage As Range, c As Range
 
On Error GoTo Fin:
Set plage = Union(Range("K1:K52"), Range("O11:O52"), Range("T11:T52")) '...mettre tous les plages
Application.EnableEvents = False
If Not Intersect(Target, plage) Is Nothing Then
    Set plage = Intersect(Target, plage)
    For Each c In plage
        If c.Value = "" Then c.Offset(0, 2).ClearContents
    Next c
    Set plage = Nothing
End If
Fin:
Application.EnableEvents = True
End Sub
 
 
'sur évènement change
Private Sub Worksheet_Change(ByVal Target As Range)
Mobi Target
End Sub
 
'sur autre évènement
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Mobi Union(Range("K1:K52"), Range("O11:O52"), Range("T11:T52")) '...mettre tous les plages
End Sub

**mobiclick** · 09/09/2010, 19h08

Excellent...ça marche à merveille ...pas de séisme sur ma feuille d ecalcul...juste un détail:j'aimerais ajouter Range("Z13:Z51") avec un offset(0,3).Est -ce que c'est possible ?

**mercatog** · 09/09/2010, 19h27

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
Sub Mobi(ByVal Target As Range)
Dim plage As Range, c As Range
 
On Error GoTo Fin:
Set plage = Union(Range("K1:K52"), Range("O11:O52"), Range("T11:T52"),Range("Z13:Z51") ) '...mettre toutes les plages
Application.EnableEvents = False
If Not Intersect(Target, plage) Is Nothing Then
    Set plage = Intersect(Target, plage)
    For Each c In plage
        If c.Value = "" Then IIf(c.Column = 26, c.Offset(0, 3), c.Offset(0, 2)).ClearContents
    Next c
    Set plage = Nothing
End If
Fin:
Application.EnableEvents = True
End Sub

**mobiclick** · 09/09/2010, 20h05

Merci Mercatog...
Le contenu des cellules Offset (0,3) ne s'efface tjrs pas ...j'essaye de voir qu'est-ce qui tourne pas rond

**mercatog** · 09/09/2010, 20h09

pourtant j'ai testé!!!
as tu ajouté la range Z ici

Code :

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

1
2
3
4
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Mobi Union(Range("K1:K52"), Range("O11:O52"), Range("T11:T52"), range("Z13:Z51")) '...mettre tous les plages
End Sub

**mobiclick** · 09/09/2010, 21h04

Effectivement ,je l'ai essayé dans un nouveau classeur et il fonctione à merveille ...je vais tester avant de poster...cooool

**babaothe** · 09/09/2010, 21h07

salut
l'évènement Activate se déclenche à l'activation

si tu as bien rajouté ce que t'a demandé de faire Mercatog, quitte ton appli puis reviens en mode exécution (pour déclencher l'évènement), de sorte à passer en situation "normale" d'utilisation.

**mobiclick** · 09/09/2010, 21h32

Après plusieurs tests,je pense que c'est à cause des cellules fusionnées que la macro ne fonctionn pas pour Range("Z13:Z51").
En effet,la cellule "Z13" par exemple est le résultat de la fusion des cellules Z13 à AD13. En annulant la fusion et en respectant l'ordre Offset(0,3) la macro fonctionne.
PS:même la cellule Offset(0,3) est une plage de cellules fusionnées.
Merci

**mobiclick** · 10/09/2010, 13h36

Je confirme que c'est bien la cellule offset(0,3) qui pose problême.Lorsque j'annule la fusion des cellules (AG13,AH13,AG14,AH14) la macro reconnait AG1 comme Offset(0,3) et donc son contenu s'efface si ZA11 est vide.Malheureusement ,pour des raison de mise en page ,je ne peux pas annuler la fusion des cellules concernées.

macro qui fait trembler ma feuille de calcul

Macros et VBA Excel

Discussions similaires

Partager

Partager