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
Code du module 3
( ce code va bien jusqu'au bout puisque
fonctionne):
Dans le code du module 3 on appele la macro S_FX_traitement dont voici le code
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
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
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
VB:
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
Code:
Sheets("Current_market").Range("G3") = Sheets("GMRB_Raw_Data").Range("A2")
VB:
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
VB:
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
VB:
' 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
Dernière édition: