Macro probleme...Activation Module de Feuille alors que absolument pas concerne......

[sim]

Bonjour a toutes et a tous!!

J'ai un gros probleme sur mes code....

La situation J'ai un bouton qui appel un module standard ( pour mettre a jour) qui travaille les donnee d'une feuille.

MAIS juste apres le travail de cette feuille le debugueur s'arrete sur une ligne d'une macro place dans un module de feuille qui n'est absolument pas concerne!


Du coup je comprend vraiment pas voici donc les code.

Code du bouton qui active la Module de mise a jour

Private Sub B_update_Click()
'Call the code written in the module 3

    Call Module3.B_update
End Sub

Code du module 3


( ce code va bien jusqu'au bout puisque

Sheets("Current_market").Range("G3") = Sheets("GMRB_Raw_Data").Range("A2")

fonctionne):

Sub B_update()

' Code to Update FX
' Copy "GMRB_Raw_Data" and rename it FX
' We call the Macro which work out FX
' Copy of the Data Version in "Current_Market"
' We refresh the Pivot Table, to have the new datas display in "Current_market"

  Application.ScreenUpdating = False
  
' Copy "GMRB_Raw_Data" and rename it FX
  
  Sheets("GMRB_Raw_Data").Copy Before:=Sheets("Markets_PI")
  On Error Resume Next
  If Err.Number <> 0 Then
    Application.DisplayAlerts = 0
    ActiveSheet.Delete
    Application.DisplayAlerts = 1
    Sheets("FX").Activate
    Exit Sub
  End If
  On Error GoTo 0
  
' We call the Macro which work out FX
  
  S_FX_traitement
  
' Copy of the Data Version in "Current_Market"
  
  Sheets("Current_market").Range("G3") = Sheets("GMRB_Raw_Data").Range("A2")
  
' We refresh the Pivot Table, to have the new datas display in "Current_market"
  
  Dim pt As PivotTable
    For Each pt In Sheets("Current_market").PivotTables
        pt.RefreshTable
    Next pt
    Sheets("Current_market").Activate
    Sheets("Current_market").Range("A1").Select
End Sub

Dans le code du module 3 on appele la macro S_FX_traitement dont voici le code

Sub S_FX_traitement()
' Code to create FX
' We replace the "-" by "--->" in the Irules
' We delete the lines with empty Irules and lines with a negative volume
' We create a new column to sort the PMI Manufacurer by tolling or non Tolling
' We define the source for the Pivot Table

Dim dl As Integer
Dim X As Integer
' We replace the "-" by "--->" in the Irules

  With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
  With ActiveSheet
    .Columns("I").Replace "-", "--->", LookAt:=xlPart
    dl = .Range("I65536").End(xlUp).Row
    For X = dl To 1 Step -1
       
' We delete the lines with empty Irules and lines with a negative volume
 
      If .Cells(X, 9).value = "" Or .Cells(X, 13) < 0 Then .Rows(X).Delete
    Next X
  End With
  With Application: .ScreenUpdating = 1: .Calculation = -4105: .EnableEvents = 1: End With
  ActiveSheet.Name = "FX"
  
' We define the source for the Pivot Table
  
  ActiveWorkbook.Names.Add Name:="basetcdauto", RefersToR1C1:= _
  "=OFFSET(FX!R1C1,0,0,COUNTA(FX!C1),15)"
  
' We create a new column to sort the PMI Manufacurer by tolling or non Tolling
  
    tablo = Sheets("Tollers").Range("B1:B7")  ' the list of Tolling Factory is in Sheet "Tollers"
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Range("H1") = "Affiliate Type"
    For n = 2 To Range("I65536").End(xlUp).Row
       If Range("G" & n) <> "TPM" Then
        For m = LBound(tablo, 1) To UBound(tablo, 1)
           If Range("I" & n) = tablo(m, 1) Then
             ok = True
             Exit For
           End If
        Next m
       If ok = False Then
          Range("H" & n) = "Non Tolling"
       Else
          Range("H" & n) = "Tolling"
       End If
       Else
        Range("H" & n) = ""
       End If
       ok = False
    Next n

End Sub

Jusque la tout va bien, sauf apres le debugueur s'arrete sur une ligne d'une macro d'une autre feuille (alors que la macro fonctionne tres bien en tps normal), et cette feuille n'a rien a voir avec le fait de mis a jour a part peut etre le fait de mettre les TCD a jour en fin de code du module 3

Donc voici le code de la feuille Current Market

' Sheet Current_market: Code
'-------------------------------------------------------------------------

Private Sub Bouton_marches_Click()
' Buton " Market's Choice", show the tool to select the market
Marches_usf.Show
End Sub
Private Sub Fill_Background(num_line, column_begin, column_end, high_area, color1)
'This put colors into the background of a cells area
'The cells area starts with the line defined by "num_line"
'The area starts with column "column_begin" until the column "column_end"
'The area size is given by "high_area" and the color by color1
Range(column_begin & num_line & ":" & column_end & (num_line + high_area - 1)).Select
Selection.Interior.ColorIndex = color1
End Sub
Private Sub Update_Array(array_title As String, value)
' This routine updates the table with the title called "array_title"
' looking at the filter defined by le field market.

 ActiveSheet.PivotTables(array_title).PivotFields("Market"). _
            CurrentPage = value
End Sub
Private Sub Add_Lines_Area(n1, n2, n3)
        'This routine adds lines.
        'The area to modify starts with the line n1 and ends at the line n2
        'We have to add lines in this area
        'These lines have to be added above n2
        'At the end the new area will have n3 lines, the firt line of n3 is n1
        'The new n2 checks that n2 = n1 + n3
        
        Range(n2 & ":" & n2).Select
        For i = 1 To n1 + n3 - n2
        Selection.Insert Shift:=xlDown
        Next
End Sub
Private Sub Delete_Lines_Up(begin_pos, nb_lines)
        'This routine delete lines
        'We will delete the lines above the line defined by begin_pos
        'nb_lines is the number of lines to delete
        
        Range(begin_pos - nb_lines & ":" & begin_pos - 1).Select
        Selection.Delete Shift:=xlUp
End Sub
Private Function Title_Position(title) As Double
' This routine gives us the line number of the cells which contains the tiltle "title"
' To know this number, we look for "title" in the sheet.
' This means that the title must be properly written.

Range("a1").Select
Title_Position = Cells.Find(What:=title, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Row
        
End Function
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 > 100 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

Bon je sais ca fait beaucoup de code, et en plus mes explications sont en anglais, mais j'ai bon espoir que vos yeux expert sauront reperer ce qui ne vas pas......

Mon projet presque fini je pense que j'aurai bcp de mal a reproduire un fichier anonyme avec la meme structure....je vous pris de m'en excuser.

Merci d'avance a ceux qui s'arreteront sur mon cas!!

Cordialement

Sim

 

[JNP]

Re : [MACRO] Activation Module de Feuille alors que absolument pas concerne!!:confuse

Bonjour Sim ,
A priori, tu as des EnableEvents qu'à certains endroits de tes macros, or il est plus prudent de les avoir uniquement en début et en fin de macro (si par un boucle, tu as 2 niveaux imbriqués, il ne faut pas oublier que c'est le premier True rencontré qui sera effectif, et non pas le 2ème ).
Personnellement, j'élargirais leur influence pour n'avoir qu'un seul niveau ...
Bon courage

 

[sim]

Re : Macro probleme...Activation Module de Feuille alors que absolument pas concerne.

Salut JNP ,

Donc j'enleve tout les enable events a l'interieur des code et je le met sous le premier Private SUb et avant le dernier End SUb, c'est ca......??

Tu crois que ca pourrait venir de la le fait que ce fichu module de feuille se lance alors qu'il n'a rien a voir avec l'histoire???

Merci car sur ce coup du courage et surtout de la tenacite me seront necessaire


J'atend ta reponse histoire d'etre sur que j'ai bien compris ce quil faut faire et apres je test..

Merci

 

[sim]

Re : Macro probleme...Activation Module de Feuille alors que absolument pas concerne.

Le forum, JNP!!!

Je viens de comprendre pourquoi ca beug mais je n'arrive pas a le regler....

Alors voila

Cette partie du codedu module 3 on une action sur la feuille Current Market ET le probleme c'est que j'ai une procedure Worksheet_change sur la feuille current market qui se declenche a ce moment la alors qu'elle ne devrais pas

voici la partie du code isole du module trois et ensuite la procedure Worksheet_change:

Le code qui fait declenche la procedure change

' Copy of the Data Version in "Current_Market"
  
  Sheets("Current_market").Range("G3") = Sheets("GMRB_Raw_Data").Range("A2")
  
' We refresh the Pivot Table, to have the new datas display in "Current_market"
  
  Dim pt As PivotTable
    For Each pt In Sheets("Current_market").PivotTables
        pt.RefreshTable
    Next pt
    Sheets("Current_market").Activate
   Sheets("Current_market").Range("A1").Select
End Sub

Et le code de la procedure change:

' Copy of the Data Version in "Current_Market"
  
'  Sheets("Current_market").Range("G3") = Sheets("GMRB_Raw_Data").Range("A2")
  
' We refresh the Pivot Table, to have the new datas display in "Current_market"
  
'  Dim pt As PivotTable
'    For Each pt In Sheets("Current_market").PivotTables
'        pt.RefreshTable
'    Next pt
'    Sheets("Current_market").Activate
'    Sheets("Current_market").Range("A1").Select
End Sub

Donc tout ca pour une question au final??!! j'ai trouver je suis trop content!!

Comment faire pour que ma procedure change ne se declenche que pour un changement dans la case G1?

Merci d'avance.

Sim

 

[JNP]

Re : Macro probleme...Activation Module de Feuille alors que absolument pas concerne.

Re ,
Euh, en début de code, tu mets

If Target.Address <> "$G$1" Then Exit Sub

mais ça veux dire aussi que tu ne feras pas les autres changements ...
Sinon, les EnableEvents servent à ça, désactiver les Change avant de modifier une feuille ...
Bon courage

 

[sim]

Re : Macro probleme...Activation Module de Feuille alors que absolument pas concerne.

JNP !!!

Oopsss dans mon d'avant je met deux fois le meme code mais tu as certainement du le retrouver plus haut

Lol bon le courage est la mais toujours pas de solution je vais finir par m'arracher les cheveux lol

En effet j'ai essayer la solution que tu donnes mais tout le reste du code ne fonctionne plus comme tu me le dis si bien!

Et la gestion des EnableEvent j'y arrive pas j'ai changer de place ce code, j'ai essyer en le mettant un peu partout ( plus que cette solution...puisque je suis desepere....

Est ce que ca t'embeterai de me rebalancer le code avec les changements...et une petite explication..si c'est pas trop te demander

 

[JNP]

Re : Macro probleme...Activation Module de Feuille alors que absolument pas concerne.

Re ,

Est ce que ca t'embeterai de me rebalancer le code avec les changements...et une petite explication..si c'est pas trop te demander

Vu le nombre de lignes du code et les différents appels de sous routine, désolé, non, je n'ai pas 3 ou 4h devant moi pour analyser ton code et le corriger, surtout que tu as ouvert un autre post ...
Ce que je ferais, c'est simplement que je passerais tous les EnableEvents du code en commentaire, et j'écrirais

Private Sub B_update_Click()
'Call the code written in the module 3
Application.EnableEvents = False
    Call Module3.B_update
Application.EnableEvents = True
End Sub

Je testerais ce code qui a toutes les chances de marcher. Puis je testerais les autres codes pour voir si tout fonctionne bien. Dans le cas contraire, j'ai eu l'impression que tu travaillais dans un USF, le plus simple serait peut être de mettre

Application.EnableEvents = False

dans l'Initialize, et de mettre

Application.EnableEvents = True

dans le Query_Close ...
Bon courage

 

[sim]

Re : Macro probleme...Activation Module de Feuille alors que absolument pas concerne.

Merci JNP

Je vais faire tout ca se soir, merci en tout cas de m'aider....je vais y arriver!! Faut garder espoir.

Merci et bonne fin de journee.

Sim.