Procedure Worksheet_change uniquement si changement dans cellule specifique

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion sim
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
S

sim

XLDnaute Occasionnel
Bonjour a tous!!

Tout est dit dans le titre,

J'ai une procedure Worksheet_change qui me pose des probleme car je ne peut rien toucher dans ma feuille sans que la macro se lance, et c'est pas du tout pratique et je dirai meme plus c'est dangereux.

Est ce que quelqu'un sait comment faire pour qu'elle ne se declenche qu'en cas de changement dans la cellule G1

Merci d'avance!! 🙂

Sim
 
Trier par date Trier par votes
Re : Procedure Worksheet_change uniquement si changement dans cellule specifique

Bonjour,

Un exemple de syntaxe pour limiter l'activation de la macro :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("G1")) Is Nothing Then
' Programmation de l'action à réaliser
End If
End Sub
 
Vote positif 0 Vote négatif
Re : Procedure Worksheet_change uniquement si changement dans cellule specifique

Bonjour!!

Merci pour vos reponses respective mais je n'arrive pas a le faire fonctionner mon code etant tres long je ne sais pas ou placer le End If

Me permetteriez vous de coller mon code ici pour me dire ce que je dois faire...si c'est pas trop demander..🙂

Merci.

Sim
 
Vote positif 0 Vote négatif
Re : Procedure Worksheet_change uniquement si changement dans cellule specifique

Bonjour à tous

avec la réponse de bernard en post 2, pas besoin de "end if", tu places le code sur la 1ère ligne de la procédure...

bon après midi
@+
 
Vote positif 0 Vote négatif
Re : Procedure Worksheet_change uniquement si changement dans cellule specifique

Cher tous!!! 🙂

En effet la solution de Bernar alias Dranreb a le gors avantage de ne pas faire buguer ma mise a jour

Mais je sais pas pourquoi du coup le reste de la procedure ne se fait pas....je me permet de coller le code vous y verrez peut etre plus clair.

Pour l'histoire, je pense que c'est important ma procedure de MISE A JOUR des donneeS

Copie une cellule d'une feuille vers la feuille ou il y a la procedure Worksheet_change ( feuille Current_market)
Met a jours les TCD dans la feuille Current_ market

Voici donc cle code du module de feuille de current market ( contrairement a la mise ajour la CONSULTATION des donnee ne pose pas de probleme, donc ce code marche, sauf pour la mise a jour

Le code:

VB: 
 Private Sub Worksheet_Change(ByVal Target As Range)

'Variables definition
Dim h1, h2, high_pt As Double                   ' variables used for calculation
Dim ht1, ht2, ht4, ht5, ht6 As Double          ' maximal size of areas of tables
Dim t1, t2, t3, t4, t5 As String            ' definition of the titles

'Titles which give us the position of each table and the maximum size of their area
' 1 area = 1 line for the title, 1 empty line, the the Pivot Table which starts just after the filter,
' then  1 empty line, the table, and empty lines until the next title.

t1 = "Interco Price Methodology and Incoterms"
ht1 = 27

t2 = "Affiliate selling to the Market's Distributor by Product Category"
ht2 = 26

t3 = "Business Flows"
ht4 = 46

t4 = "Factories and Brands"
ht5 = 56

t5 = "Royalties and Entrepreneur"

color_fill = 15  ' grey, used to color the field title of each Pivot

'Sow every lines.
'Each time we change market lines are hidden, we have to show them all to create the next market

ActiveSheet.Rows.EntireRow.Hidden = False
 
Application.EnableEvents = False
    
'Delete all colors in the sheet, starts line 2 because line 1 we have cell "G1" the market name.
 Range("a2:Z500").Select
 Selection.Interior.ColorIndex = 0
 
 Range("A1").Select
 
 Application.ScreenUpdating = False
 
 ' PIVOT TABLE UPDATE
 ' -----------------------------------------------------------------
 
 If Target.Address = "$G$1" Then  'VERY IMPORTANT : IN THIS CELL IS THE MARKET NAME.
 
        On Error Resume Next
        
        'Rajout de lignes vides pour que la zone ait la hauteur ht1 Lines added in order to have ht1 size
        'Mise à jour du tableau, puis calcul de la hauteur du tableau après sa mise à jour Update table then calculation of the size of the new Pivot
        'We delete empty lines in order to have only 2 lines after the pivot table
        
        'TABLE "Price"
        Call Add_Lines_Area(Title_Position(t1), Title_Position(t2), ht1)
        Call Update_Array("price", Target.value)
        high_pt = ActiveSheet.PivotTables("price").TableRange2.Rows.Count
        Call Delete_Lines_Up(Title_Position(t2), ht1 - high_pt - 4)

        'TABLE "affiliate"
        Call Add_Lines_Area(Title_Position(t2), Title_Position(t3), ht2)
        Call Update_Array("affiliate", Target.value)
        high_pt = ActiveSheet.PivotTables("affiliate").TableRange2.Rows.Count
        Call Delete_Lines_Up(Title_Position(t3), ht2 - high_pt - 4)
        
        'TABLE "flows"
        Call Add_Lines_Area(Title_Position(t3), Title_Position(t4), ht4)
        Call Update_Array("flows", Target.value)
        high_pt = ActiveSheet.PivotTables("flows").TableRange2.Rows.Count
        Call Delete_Lines_Up(Title_Position(t4), ht4 - high_pt - 4)
        
        'TABLE "brand"
        Call Add_Lines_Area(Title_Position(t4), Title_Position(t5), ht5)
        Call Update_Array("brand", Target.value)
        high_pt = ActiveSheet.PivotTables("brand").TableRange2.Rows.Count
        Call Delete_Lines_Up(Title_Position(t5), ht5 - high_pt - 4)
        
        'TABLE "royalty"
        Call Update_Array("royalty", Target.value)
               
        On Error GoTo 0
 End If

'Split the report into 2 or 3 pages
'--------------------------------------------------------

'We delete the PageBreaks
 ActiveSheet.PageSetup.PrintArea = "$A$1:$Z$1000"  'we go to this line, it should be sufficient
 On Error Resume Next
    For j = ActiveSheet.HPageBreaks.Count To 1 Step -1
        ActiveSheet.HPageBreaks(j).Delete
    Next j
 On Error GoTo 0
  
'We hide the lines which contains the filter ( Gain of 10 lines fot printing )
 h1 = Title_Position(t1)
 Rows(h1 + 2 & ":" & h1 + 4).Select
 Selection.EntireRow.Hidden = True
      
 h1 = Title_Position(t2)
 Rows(h1 + 2 & ":" & h1 + 4).Select
 Selection.EntireRow.Hidden = True
           
 h1 = Title_Position(t3)
 Rows(h1 + 2 & ":" & h1 + 4).Select
 Selection.EntireRow.Hidden = True
                
 h1 = Title_Position(t4)
 Rows(h1 + 2 & ":" & h1 + 4).Select
 Selection.EntireRow.Hidden = True
                     
 h1 = Title_Position(t5)
 Rows(h1 + 2 & ":" & h1 + 4).Select
 Selection.EntireRow.Hidden = True
   
'"Factory and Brand" and "Royalties and Entrepreneur" into the page 2
 h1 = Title_Position(t4)
 Range("a" & h1).Select
 ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell   'on place un saut de page
  
'If needed "Royalties and Entrepreneur" in page 3


 h1 = Title_Position(t5)                                                'table position
 hight_pt = ActiveSheet.PivotTables("royalty").TableRange2.Rows.Count   'table size
 
 If h1 + 1 + high_pt > 50 Then  'Page 2 contains 100 lines as a maximum, if more "Royalties and Entrepreneur" goes to page 3
 Range("a" & h1).Select
 ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
 End If

 
 'For Excel 2007, we have to hide the pivot buton for printing.
 ' ---------------------------------------------------------------------------
 'ActiveSheet.PivotTables("price").ShowDrillIndicators = False
 'ActiveSheet.PivotTables("affiliate").ShowDrillIndicators = False
 'ActiveSheet.PivotTables("flows").ShowDrillIndicators = False
 'ActiveSheet.PivotTables("brand").ShowDrillIndicators = False
 'ActiveSheet.PivotTables("royalty").ShowDrillIndicators = False
 
 'Improvement of table 'Affiliate', borders of the right side.
'-------------------------------------------------------------

'definition of the wanted area
 h1 = Title_Position(t2)                     ' we choose th right table
 h2 = ActiveSheet.PivotTables("affiliate").TableRange2.Rows.Count     'we want to know the size of the table from the filter to the last line
 Range("D" & h1 + 5 & ":D" & h1 + h2 + 1).Select    ' We select the area we want to improove.
  
 'We remove all borders of the selection
  Selection.Borders.LineStyle = xlNone
   
 ' Then we put borders around the table
  With Selection
  .BorderAround LineStyle:=xlContinuous
  .BorderAround Weight:=xlThin
  .BorderAround ColorIndex = 1
  End With
  
  'Then we add Horizontal lines
   If Selection.Rows.Count > 1 Then
    Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End If
 
 
 'Improvement of table"flows"
 '------------------------------
 '
  
 'definition of the wanted area
 h1 = Title_Position(t3)            ' we choose th right table
 h2 = ActiveSheet.PivotTables("flows").TableRange2.Rows.Count   'we want to know the size of the table from the filter to the last line
 Range("E" & h1 + 6 & ":H" & h1 + h2 + 1).Select ' We select the area we want to improove.
 
  'Irules in Arial Narrow, to gain space
    With Selection.Font
        .Name = "Arial Narrow"
        .Size = 9
    End With
 
 'We remove all borders of the selection
  Selection.Borders.LineStyle = xlNone
   
  ' Then we put borders around the table
  With Selection
  .BorderAround LineStyle:=xlContinuous
  .BorderAround Weight:=xlThin
  .BorderAround ColorIndex = 1
  End With
  
  'Then we add Horizontal lines
   If Selection.Rows.Count > 1 Then
    Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End If

    
''Improvement of table 'Factories and Brand', borders of the right side.
'--------------------------------------------------------------------------
'definition of the wanted area
 h1 = Title_Position(t4)
 h2 = ActiveSheet.PivotTables("brand").TableRange2.Rows.Count
 Range("G" & h1 + 5 & ":G" & h1 + h2 + 1).Select
 
 'We remove all borders of the selection
  Selection.Borders.LineStyle = xlNone
   
  ' Then we put borders around the table
  With Selection
  .BorderAround LineStyle:=xlContinuous
  .BorderAround Weight:=xlThin
  .BorderAround ColorIndex = 1
  End With
  
  'Then we add Horizontal lines
   If Selection.Rows.Count > 1 Then
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End If


'Improvement of table "Royalty" : borders of the right side.
'-------------------------------------------------------------

'definition of the wanted area
 h1 = Title_Position(t5)
 h2 = ActiveSheet.PivotTables("royalty").TableRange2.Rows.Count
 Range("G" & h1 + 5 & ":G" & h1 + h2 + 1).Select
  
 'We remove all borders of the selection
  Selection.Borders.LineStyle = xlNone
   
 ' Then we put borders around the table
  With Selection
  .BorderAround LineStyle:=xlContinuous
  .BorderAround Weight:=xlThin
  .BorderAround ColorIndex = 1
  End With
  
  'Then we add Horizontal lines
   If Selection.Rows.Count > 1 Then
    Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End If


'Improvement of field title: fill background
'-----------------------------------------------------------
'This code works in 2003 and 2007 version
         
 Call Fill_Background(Title_Position(t1) + 5, "B", "F", 1, color_fill)  'table "Price", regarding the title, the field title is 5 lines below
 Call Fill_Background(Title_Position(t2) + 5, "B", "D", 1, color_fill)  'table "affiliate"
 Call Fill_Background(Title_Position(t3) + 5, "B", "E", 1, color_fill)  'table "flows"
 Call Fill_Background(Title_Position(t4) + 5, "B", "G", 1, color_fill)  'table "brand"
 Call Fill_Background(Title_Position(t5) + 5, "B", "G", 1, color_fill)  'table "royalty"

    
' PRINTING
' ---------------------------

   'Print Area stops just after the last Pivot Table
   'looking for the line just after the pivot
    h1 = Title_Position(t5) + 2 + ActiveSheet.PivotTables("royalty").TableRange2.Rows.Count
 
   'Restricted print area
    ActiveSheet.PageSetup.PrintArea = "$A$1:$H$" & h1
        
 '   Application.PrintCommunication = False 'this code is available only for 2007
      With ActiveSheet.PageSetup
        .Zoom = 70  ' zoom at 70%
      End With
 '   Application.PrintCommunication = True  'this code is available only for 2007
        
    
 Range("a1").Select

 Application.EnableEvents = True
 
End Sub

Merci d'avance 🙂

Sim
 
Vote positif 0 Vote négatif
Re : Procedure Worksheet_change uniquement si changement dans cellule specifique

Là, c'est carrément différent du titre qui parle d'une Workseet uniquement si... Et qu'on ne peut approcher que par un Exit Sub si pas...
Pas envie d'étudier le code. Trop gros.
 
Vote positif 0 Vote négatif
Re : Procedure Worksheet_change uniquement si changement dans cellule specifique

Pierrot,

Je sais, je pensais que je devais redefinir la question car la premiere etait trop vaste, avec tout ces codes....ca aurait pu perdre les gens qui nous aide.....pardon! 🙁 je mettrai un lien vers l'autre discussion dans chacune d'entre elle a la fin....J'ai lu la charte au moins 3 fois je promet!! et essaye de l'appliquer a la regle..

Sim
 
Vote positif 0 Vote négatif
Re : Procedure Worksheet_change uniquement si changement dans cellule specifique

Bonjour.
Il n'est pas possible d'écrire une deuxième Worksheet_Change pour une feuille (j'ai seulement compris que c'était ça votre idée) mais il m'arrive parfois d'en faire de très courtes qui appellent une ou plusieurs procédures écrites dans des modules standards. Cela permet de n'avoir qu'un code à maintenir pour plusieurs feuilles devant avoir les mêmes réactions aux évènements Excel.
Dans votre cas celà permettrait d'avoir du code paraissant plus conci, en tout cas mieux organisé, une des procédure n'étant exécutée que si la cellule modifiée est la G1.
 
Vote positif 0 Vote négatif
Re : Procedure Worksheet_change uniquement si changement dans cellule specifique

Dranreb,

Malheureusement, je reste encore un prfoane en VBA et j'ai beaucoup de mal a voir ce qu'il faut faire pour regler ce probleme je vais essayer de vous le reexpliquer de maniere claire et consise.

J'ai une feuille "Home" qui sert d'interface utilisateur.
Dans cette feuille j'ai un bouton qui lance une macro dont le but et de mettre a jour mes donnees. Cette macro est dans un module standard Numero3

La seule intervention "humaine'' se fait avant d'appuyer sur le bouton, il s'agit de coller dans une feuille que nous appelerons "Brute", un tableau comportant les nouvelle donnes.

Dans cette macro il y a trois etape principale.

1) D'abord on fait une copie de "Brute" qu'on renomme "FX"

2) Ensuite on appel une macro placer dans un module standard qui travaille les donnees dans FX, elle est placee dans le Module1.

3) Ensuite on fait une copie de la cellule A2 de "Brute" dans la feuille Current_Market.
Et on met a jour les TCD dans la feuille Current_market

La feuille Current_market est la pierre angulaire de mon application.

Elle permet de connaitre les informations d'un marche. On choisi le marche grace a une userform.
La validation du marche dans la userform ne fait que changer le nom du marche en G1
Et ensuite j'ai une macro qui fait evoluer mes TCD en fonction du marche situe en G1.

J'ai placer dans le module de cette feuille (current market) un code asses long ( cf post #8)

Son fonctionnement tres simplifie est le suivant:

Il y a une une procedure Worksheet_change dans laquelle j'ai inserrer le code pour mettre mes TCD a jour.
Mais aussi un code qui calcul la taille de mes TCD afin de toujours avoir la meme mise en page ( suppression de ligne, saut de page en fonction taille TCD, changement de certaine bordure....etc)
Et pour finir un petit code qui prepare l'impression

Donc en fait le probleme c'est aue le petit 3) de mon explication provoque en effet un changement dans Current_market et lance la procedure Worksheet_change. Ce que je voudrait eviter puisque ca fait out beuguer.

Si on prend le probleme d'un autre point de vue. Quand je passe le 3) en commentaire tout fonctionne
et de meme si je passe le 3) dans le code de validation du marche cela fonctionne, mais alourdie encore le processus de changement de marche.

Chaque changement de marche mais environ 10 seconde voire 15 seconde. Donc il y a definitivement un probleme

Si jamais j'ai un exemple grandeur nature, que je ne pas mettre ici car meme zippe il est trop lourd. Mais si jamais quelqu'un etait pres a m'aider je pourrais toujours l'envoyer par mail.


J'ai encore essayer toute la matinee mais rien n'y fait je suisvraiement bloque.

Voili voilou..

Merci d'avance

Sim
 
Vote positif 0 Vote négatif
Re : Procedure Worksheet_change uniquement si changement dans cellule specifique

Pour que la modification d'une cellule depuis du code ne provoque pas d'exécution intempestive voire récursive d'une Workseet_Change, il faut placer
VB: 
Application.EnableEvents = False
devant, et ne surtout pas oublier de le remettre à True ensuite, sinon plus aucune procédure d'évenement ne fonctionnera pour l'utilisateur.
À+
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Y
  • Résolu(e)
XL 2013 Macro si changement dans case à cocher
Réponses
6
Affichages
513
Yvan1
Y
E
  • Résolu(e)
XL 2013 Rechercher et modifier la valeur d'une cellule dans tout un classeur
2
Réponses
21
Affichages
2 K
EXCJPH
E
S
  • Question Question
XL 2016 Cellule change de couleur si la valeur existe dans une autre cellule d'un autre onglet
Réponses
12
Affichages
1 K
sum01
S
P
  • Question Question
Microsoft 365 Exécution lors d'un changement d'une Cellule
Réponses
11
Affichages
1 K
Payne
P
B
  • Question Question
XL 2016 Déclencher une macro après validation d'une cellule
Réponses
5
Affichages
892
sylvanu
sylvanu
P
  • Résolu(e)
Microsoft 365 Copier et coller une ligne dans une autre cellule si la condition est respectée
Réponses
10
Affichages
2 K
Piksaw
P
C
  • Question Question
XL 2013 VBA - Copier coller valeurs uniquement - Macro consolidation
Réponses
1
Affichages
2 K
sylvanu
sylvanu
B
  • Résolu(e)
XL 2013 Insérer une image dans une cellule, l'ajuster à la taille de la cellule et l'enregistrer avec le classeur
Réponses
1
Affichages
2 K
Lolote83
L
Anthonymctm
  • Question Question
XL 2016 Cadrage et propriété d'images issues d'une macro
Réponses
6
Affichages
1 K
Anthonymctm
Anthonymctm
castor30
  • Question Question
RESOLU par Robert que je remercie - Exécution auto macro si changement dans feuille
Réponses
10
Affichages
1 K
castor30
castor30
chris6999
  • Question Question
Worksheet_Change(ByVal .. avec cellule fusionnée
Réponses
2
Affichages
691
chris6999
chris6999
L
  • Question Question
Cas de non détection d'un changement de valeur de cellule dans Worksheet_Change
Réponses
5
Affichages
2 K
job75
job75
S
  • Question Question
Copie du contenu d'une cellule dans le Presse-Papiers en fin de code + formule
Réponses
7
Affichages
2 K
Shinpi
S
G
  • Question Question
Insertion d'image en fonction du résultat d'une celulle ( +20 000 résultats possible)
Réponses
3
Affichages
1 K
Lone-wolf
Lone-wolf
L
  • Question Question
XL 2013 Deplacer Formes/Shapes pour gerer l'espace dans un entrepot
Réponses
3
Affichages
1 K
youky(BJ)
youky(BJ)
escouger
  • Question Question
Déclencher une action si la valeur résultat d'une cellule a changé
Réponses
8
Affichages
2 K
escouger
escouger
GADENSEB
  • Question Question
XLA / Click dans une cellule changement de couleur de ligne et colonne (temporaire)
Réponses
6
Affichages
1 K
Staple1600
Staple1600
B
  • Question Question
Suivi des modifications d'une cellule dans une feuille vers une autres
Réponses
8
Affichages
1 K
bassmart
B
brounch
  • Question Question
Comparaison et sélection des occurrences d'une cellule dans une colonne
Réponses
4
Affichages
1 K
brounch
brounch
N
  • Question Question
Macros simples qui rament dans gros fichier excel
Réponses
9
Affichages
2 K
nicopat
N
Retour