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
