Attribute VB_Name = "Module12"
'Chart Utilities
'------------------------------------------------

Sub FmtCht()

'
' FmtCht Macro
' Format Chart Titles, Legends, Labels.
'

    If ActiveChart.HasTitle Then
      ActiveChart.ChartTitle.Select
    End If
    
    ActiveChart.Axes(xlCategory).Select
    Selection.TickLabels.AutoScaleFont = True
    With Selection.TickLabels.Font
        .Name = "Verdana"
        .FontStyle = "Regular"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    
    ActiveChart.Axes(xlValue).Select
    
    Selection.TickLabels.AutoScaleFont = True
    With Selection.TickLabels.Font
        .Name = "Verdana"
        .FontStyle = "Regular"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    
    ActiveChart.Axes(xlCategory).Select
    With Selection.Border
        .Weight = xlHairline
        .LineStyle = xlAutomatic
    End With
    With Selection
        .MajorTickMark = xlCross
        .MinorTickMark = xlNone
        .TickLabelPosition = xlNextToAxis
    End With
    
    If ActiveChart.HasLegend Then
      ActiveChart.Legend.Select
      With Selection.Border
        .Weight = xlHairline
        .LineStyle = xlNone
      End With
      Selection.Position = xlTop
      Selection.AutoScaleFont = True
      With Selection.Font
        .Name = "Verdana"
        .FontStyle = "Regular"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
      End With
    End If
    
    If ActiveChart.HasTitle Then
      ActiveChart.ChartTitle.Select
      Selection.AutoScaleFont = True
      With Selection.Font
        .Name = "Verdana"
        .FontStyle = "Bold"
        .Size = 22
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
      End With
    End If
    
    ' Begin Added 070904 -----------------------
    If (ActiveChart.Axes(xlCategory).HasTitle) Then
      ActiveChart.Axes(xlCategory).axistitle.Select
      Selection.AutoScaleFont = True
      With Selection.Font
          .Name = "Verdana"
          .Size = 18
          .Strikethrough = False
          .Superscript = False
          .Subscript = False
          .OutlineFont = False
          .Shadow = False
          .Underline = xlUnderlineStyleNone
          .ColorIndex = xlAutomatic
          .Background = xlAutomatic
      End With
    End If
    
    If (ActiveChart.Axes(xlValue).HasTitle) Then
      ActiveChart.Axes(xlValue).axistitle.Select
      Selection.AutoScaleFont = True
      With Selection.Font
          .Name = "Verdana"
          .Size = 18
          .Strikethrough = False
          .Superscript = False
          .Subscript = False
          .OutlineFont = False
          .Shadow = False
          .Underline = xlUnderlineStyleNone
          .ColorIndex = xlAutomatic
          .Background = xlAutomatic
      End With
    End If
        
        ' End Added 070904 -----------------------
        
        ' Begin Added 070906 ---------------------
    ' Rotate X-Axis Tick Labels 90-degrees clockwise
    ActiveChart.Axes(xlCategory).Select
    With Selection.TickLabels
        .Alignment = xlCenter
        .Offset = 100
        .ReadingOrder = xlContext
        .Orientation = xlDownward
    End With
        ' End Added 070906 ---------------------
        
    Sheets(ActiveChart.Name).Move Before:=Sheets(1)  ' move to 1st tab


    
End Sub 'FmtCht
Sub FmtMkrLeg()

  ' Formats the legends and backgrounds for clarity
  ' Converts the chart to Line type
  '
  ' Example:
  '
  ' Dim MyChart as Chart
  ' Set MyChart = ActiveChart
  ' FmtLeg MyChart
  '
  ' See also Sub CvtChtToColumn
  
  
Dim Color As Variant         ' Colors suitable for white background
Dim LineWt As Variant         ' Line weights
Dim Mkr As Variant            ' Markers
Dim Chobj As Chart
Dim Zrange(2) As Variant         ' High & low Z-values

Set Chobj = ActiveChart       ' Chart object
Chobj.ChartType = xlLineMarkers ' CONVERT TO Line

MkrF = 0 '
BgColor = Array(xlNone, 19, 20, 35)
'BgColor = Array(xlNone, 19, 20, 35, 15) ' That grey is just ugly
'Color = Array(12, 44, 14, 45, 37, 46, 40, 47, 50, 41, 3, 42, 5)
Color = Array(12, 44, 14, 45, 37, 46, 40, 47, 50, 41, 3, 42)
LineWt = Array(xlThick, xlMedium) ', xlThin
Mkr = Array(xlPlus, xlDiamond, xlTriangle, xlSquare, xlStar, xlCircle)

k = Chobj.SeriesCollection.Count      ' How many Legends to format
If Chobj.HasLegend = False Then GoTo LegFini

j = 0        ' series index
L = 1        ' Line width
Z = 3        ' marker size


Randomize (Timer Mod 50000)

c = Int((1 + UBound(Color)) * Rnd)    ' Line color

b = Int((1 + UBound(BgColor)) * Rnd)  ' Background Color
    Chobj.PlotArea.Select
    With Selection.Interior
        .ColorIndex = BgColor(b)
        .PatternColorIndex = 1
        .Pattern = xlSolid
    End With

m = Int((1 + UBound(Mkr)) * Rnd)    ' marker style


  If (k < 4) Then
    L = 0                           ' Thick
  Else
    L = 1                           ' Thin
  End If
  
  
For j = 1 To k                    ' Loop the Legends

  c = ((c + 1) Mod (1 + UBound(Color))) ' Color
  Do While ( _
       (BgColor(b) = Color(c)) _
    Or (BgColor(b) = 15 And Color(c) = 42) _
    Or (BgColor(b) = 20 And Color(c) = 42) _
    )
    c = ((c + 1) Mod (1 + UBound(Color))) ' Avoid low constrast Color
  Loop  ' End Do While

  
  'L = ((L + 1) Mod (UBound(LineWt))) ' Line weight
  m = ((m + 1) Mod (1 + UBound(Mkr)))  ' Marker type
  If (k < 4) Then
    L = 0                           ' Thick
  Else
    L = 1                           ' Thin
  End If
    
  Z = ((Z + 1) Mod (10))             ' Marker size
    If k < 4 Then                    ' a small number of series
      If Z < 8 Then
        Z = 8
      End If
    Else                             ' a large number of series
      If Z > 7 Then
        Z = 6
      End If
    End If
        
            
    Chobj.Legend.LegendEntries(j).LegendKey.Select
    Chobj.Legend.Select
    Chobj.Legend.LegendEntries(j).LegendKey.Select
    With Selection.Border
        .ColorIndex = Color(c)
        .Weight = LineWt(L)
        .LineStyle = xlContinuous
    End With
    
          With Selection
            .MarkerStyle = Mkr(m)
          End With
          
          
          If (Rnd > 0.5) Then
            With Selection
              .MarkerBackgroundColorIndex = Color(c)
              Z = Z - 4
              If (Mkr(m) = xlCircle Or Mkr(m) = xlDiamond _
                  Or Mkr(m) = xlTriangle _
              ) Then Z = Z + 4
              If Z < 3 Then
                Z = 3
              End If
            End With
          Else
            If Z < 6 Then
              Z = 6
            End If
            With Selection
              .MarkerBackgroundColorIndex = xlNone
            End With
          End If
    

    With Selection
        .MarkerForegroundColorIndex = Color(c)
        .Smooth = False
        .MarkerSize = Z
        .Shadow = False
    End With
    
          
Next ' J

LegFini:

      

  
End Sub ' FmtMkrLeg
  
Sub ChartHeadAndFoot()
'
' ChartHeadAndFoot Macro

' Dan's Favorite Headers and Footers for Charts
'
' Standard Headers and Footers for Charts
'

'
    With ActiveChart.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = "&8Daniel Brockman, &D"
        .CenterFooter = "&A"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .ChartSize = xlFullPage
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        '.PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .BlackAndWhite = False
        .Zoom = 100
    End With
End Sub ' ChartHeadAndFoot



Sub AddNewSeries( _
  Chobj As Chart, _
  Shobj As Worksheet, _
  Nm As String, _
  Yv As String, Yvr, Yvc, _
  Xv As String, Xvr, Xvc) 'Add series to active chart
' From http://peltiertech.com/Excel/ChartsHowTo/QuickChartVBA.html
'
' Sets up new series in Chart
' Shobj = Sheets object from which to draw series
' Nm    = Cell addr of Series name
' Yv    = Upper left cell addr of Yvalues range
' Yvr   = Row offset from Yv, >=0
' Yvc   = Column offset from Yv, >=0
' Xv    = Upper left cell addr of Xvalues range
' Xvr   = Row offset from Xv, >=0
' Xvc   = Column offset from Xv, >=0
'
' Example:
'
'   Dim MySobj as Worksheet
'   Dim MyCobj as Chart
'   Set MySobj = Sheets("mysheet")              ' source of data
'   Charts Add                                  ' create new chart
'   MyCobj = ActiveChart
'   AddNewSeries MyCobj, Mysobj,"G1","G3",24,0,"A3",24,0    ' add series
'
   
    NmAddr = Shobj.Range(Nm).Address
    YvAddr = Shobj.Range(Yv).Address
    XvAddr = Shobj.Range(Xv).Address
    SerNam = Shobj.Range(Nm).value
    
    Chobj.SeriesCollection.NewSeries   ' Start new series
    Scc = Chobj.SeriesCollection.Count
    Chobj.SeriesCollection(Scc).XValues = "='" & Shobj.Name & "'!" & Shobj.Range(XvAddr, Shobj.Range(XvAddr).Offset(Xvr, Xvc)).Address(ReferenceStyle:=xlR1C1)
    Chobj.SeriesCollection(Scc).Name = SerNam & "  "
    Chobj.SeriesCollection(Scc).Values = "='" & Shobj.Name & "'!" & Shobj.Range(YvAddr, Shobj.Range(YvAddr).Offset(Yvr, Yvc)).Address(ReferenceStyle:=xlR1C1)
    'Shobj.[CC24].Formula = "='" & Shobj.Name & "'!" & Shobj.Range(XvAddr, Shobj.Range(XvAddr).Offset(Xvr, Xvc)).Address(ReferenceStyle:=xlR1C1)
    'Chobj.SeriesCollection(Scc).XValues = "='" & Shobj.Name & "'!" & Shobj.Range(XvAddr, Shobj.Range(XvAddr).Offset(Xvr, Xvc)).Address(ReferenceStyle:=xlR1C1)
     
End Sub 'AddNewSeries

Sub RemoveUnwantedSeries()
' From http://peltiertech.com/Excel/ChartsHowTo/QuickChartVBA.html

    'Switch chart types to reliably delete series
    'From http://www.mcse.ms/message895489.html
    Holdtype = ActiveChart.ChartType
    ActiveChart.ChartType = xlColumnClustered
    
    With ActiveChart
        Do Until .SeriesCollection.Count = 0
        
            .SeriesCollection(1).Delete
        Loop
    End With
    
    'Switch back
    ActiveChart.ChartType = Holdtype
    
End Sub
Sub YaxisNumFmt(FFF)
' Use to format Y axis tick labels
' Example: YaxisNumFmt("0.00%")
    ActiveChart.Axes(xlValue).Select
    Selection.TickLabels.NumberFormat = FFF
End Sub 'YaxisNumFmt
Sub XaxisNumFmt(FFF)
' Use to format X axis tick labels
' Example: XaxisNumFmt("dd-mmm-yyyy")
    ActiveChart.Axes(xlCategory).Select
    Selection.TickLabels.NumberFormat = FFF
End Sub 'XaxisNumFmt


Sub StartChart(Chobj As Chart, ChartName, _
               Shobj As Worksheet, _
               RngStr, _
               Optional ctitle As String = "", _
               Optional xtitle As String = "", _
               Optional Ytitle As String = "", _
               Optional cr As Variant = 0 _
)
               

' Initiate a chart.
' Written for first use with transfer scheduling reports.
' StartChart initiates a basic chart ready for addition of series.
'
' Chobj     = A chart object to work on
' ChartName = a short string that will appear on the tab for the chart
' Shobj     = Worksheet object containing data for chart Source range
' RngStr    = Chart data range string for use in Shobj.Range(RngStr)
' ctitle    = Title for top of the chart
' xtitle    = Title for the xaxis
' ytitle    = title for the yaxis
' cr        = 0 = data in columns
'             1 = data in rows
'
' Example:
'
'   Dim Chobj as Chart
'   Dim Shobj as Worksheet
'   RngStr = "A2:C92"
'   Set Shobj = Sheets("mydata")
'   Shobj.Select
'   StartChart(Chobj,"Weekly Report",Shobj,RngStr, _
'      "Weekly Ice Cream Sales", _
'      "", _
'      "Metric Tons")
'   Chobj.Activate
'   AddNewSeries Chobj, Shobj, "B1", "B3", LRm3, 0, "A3", LRm3, 0
'   AddNewSeries Chobj, Shobj, "C1", "C3", LRm3, 0, "A3", LRm3, 0
'

   'Rows and Columns
    If (rc = 0) Then tow = xlColumns
    If (rc = 1) Then tow = xlRows
    
    Shobj.Activate
    Shobj.Range(RngStr).Select
    
    Charts.Add
    Set Chobj = ActiveChart  ' Define objects
        
    Chobj.ChartType = xlLineMarkers
    Chobj.SetSourceData Source:=Shobj.Range(RngStr), _
        PlotBy:=tow
    Chobj.Location Where:=xlLocationAsNewSheet, Name:=ChartName
        
    'Titles
    Dim ct As Boolean
    Dim xt As Boolean
    Dim yt As Boolean
      ct = True
      xt = True
      yt = True
      
    If (ctitle = "") Then ct = False
    If (xtitle = "") Then xt = False
    If (Ytitle = "") Then yt = False
    
    If (ct) Then  ' chart title
      With Chobj
        .HasTitle = ct
        .ChartTitle.Characters.Text = ctitle
      End With
      Chobj.ChartTitle.Select
      Selection.AutoScaleFont = True
      With Selection.Font
        .Name = "Verdana"
        .FontStyle = "Bold"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
      End With
    End If ' chart title
    
    If (xt) Then ' xaxis title
      With Chobj
        .Axes(xlCategory, xlPrimary).HasTitle = xt
        .Axes(xlCategory, xlPrimary).axistitle.Characters.Text = _
          xtitle
      End With
    End If ' xaxis title
    
    If (yt) Then ' yaxis title
      With Chobj
        .Axes(xlValue, xlPrimary).HasTitle = yt
        .Axes(xlValue, xlPrimary).axistitle.Characters.Text = _
          Ytitle
      End With
    End If ' yaxis title
            
    Chobj.PlotArea.Select
    With Selection.Interior
        .ColorIndex = 38
        .PatternColorIndex = 1
        .Pattern = xlSolid
    End With

    Sheets(ChartName).Select
    With Chobj.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&A"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .ChartSize = xlFullPage
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        '.PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .BlackAndWhite = False
        .Zoom = 100
    End With
    
    RemoveUnwantedSeries      ' init
    
End Sub ' StartChart

Sub ContinueChart(Chobj As Chart, mju, mjus)

' Use after AddNewSeries() in same sub from which StartChart is called.
' Chobj = see StartChart()
' mju = x axis major unit See ChTotSch
' mjus = x axis major unit scale See ChTotSch

    Chobj.Select   ' 071107
    Chobj.PlotArea.Select
    With Selection.Border
        .ColorIndex = 16
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    Selection.Interior.ColorIndex = xlNone

    ' Legend
    
    Chobj.HasLegend = True
    Chobj.Legend.Position = xlTop
    Chobj.Legend.Border.LineStyle = xlNone
        
     
    ' x-axis
    With Chobj.Axes(xlCategory).TickLabels
        .Alignment = xlCenter
        .Offset = 100
        .ReadingOrder = xlContext
        .Orientation = xlDownward
    End With
    With Chobj.Axes(xlCategory)
        .HasMajorGridlines = True
        .HasMinorGridlines = False
    End With
        
    ' y-axis
    With Chobj.Axes(xlValue)
        .MinimumScaleIsAuto = True
        .HasMajorGridlines = True
        .HasMinorGridlines = False
    End With
    
    'Chobj.Axes(xlCategory).Select
    With Chobj.Axes(xlCategory)
        .MinimumScaleIsAuto = True
        .MaximumScaleIsAuto = True
        .BaseUnitIsAuto = True
        .MajorUnit = mju
        .MajorUnitScale = mjus
        .MinorUnitIsAuto = True
        .Crosses = xlAutomatic
        .AxisBetweenCategories = True
        .ReversePlotOrder = False
    End With
    Chobj.Axes(xlValue).MajorGridlines.Select
    With Chobj.Axes(xlCategory)
        .HasMajorGridlines = True
        .HasMinorGridlines = False
    End With
    With Chobj.Axes(xlValue)
        .HasMajorGridlines = True
        .HasMinorGridlines = False
    End With
    
End Sub ' ContinueChart

Sub CvtChtToColumn()

' Chart routines in this project were originally designed for
' line charts. (ActiveChart.ChartType = xlLineMarkers)
'
' CvtChtToColumn converts the chart type to columns.
' (ActiveChart.ChartType = xlColumnClustered)
' Reconversion of type may be necessary if you wish to use legacy routines.
'
' Invoke sub CvtChtToColumn after invoking sub FmtMkrLeg
'
' CvtChtToColumn is a clone of FmtMkrLeg.
' CvtChtToColumn does for column charts what FmtMkrLeg does for line charts

Dim Color As Variant         ' Colors suitable for white background
Dim LineWt As Variant         ' Line weights
Dim Mkr As Variant            ' Markers
Dim Chobj As Chart
Dim Zrange(2) As Variant         ' High & low Z-values

Set Chobj = ActiveChart       ' Chart object
Chobj.ChartType = xlColumnClustered ' CONVERT TO COLUMN

MkrF = 0 '
BgColor = Array(xlNone, 19, 20, 35)
Color = Array(12, 44, 14, 45, 37, 46, 40, 47, 50, 41, 3, 42)
LineWt = Array(xlThick, xlMedium) ', xlThin
Mkr = Array(xlPlus, xlDiamond, xlTriangle, xlSquare, xlStar, xlCircle)
'
k = Chobj.SeriesCollection.Count      ' How many Legends to format
If Chobj.HasLegend = False Then GoTo LegFini
'
j = 0        ' series index
L = 1        ' Line width
Z = 3        ' marker size


Randomize (Timer Mod 50000)

c = Int((1 + UBound(Color)) * Rnd)    ' Line color

b = Int((1 + UBound(BgColor)) * Rnd)  ' Background Color
    Chobj.PlotArea.Select
    With Selection.Interior
        .ColorIndex = BgColor(b)
        .PatternColorIndex = 1
        .Pattern = xlSolid
    End With

m = Int((1 + UBound(Mkr)) * Rnd)    ' marker style


  If (k < 4) Then
    L = 0                           ' Thick
  Else
    L = 1                           ' Thin
  End If
  
  
For j = 1 To k                    ' Loop the Legends

  c = ((c + 1) Mod (1 + UBound(Color))) ' Color
  Do While ( _
       (BgColor(b) = Color(c)) _
    Or (BgColor(b) = 15 And Color(c) = 42) _
    Or (BgColor(b) = 20 And Color(c) = 42) _
    )
    c = ((c + 1) Mod (1 + UBound(Color))) ' Avoid low constrast Color
  Loop  ' End Do While

  
  m = ((m + 1) Mod (1 + UBound(Mkr)))  ' Marker type
  If (k < 4) Then
    L = 0                           ' Thick
  Else
    L = 1                           ' Thin
  End If
    
  Z = ((Z + 1) Mod (10))             ' Marker size
    If k < 4 Then                    ' a small number of series
      If Z < 8 Then
        Z = 8
      End If
    Else                             ' a large number of series
      If Z > 7 Then
        Z = 6
      End If
    End If
        
            
    Chobj.Legend.LegendEntries(j).LegendKey.Select
    Chobj.Legend.Select
    Chobj.Legend.LegendEntries(j).LegendKey.Select
    
    With Selection.Border
        .ColorIndex = Color(c)
        .Weight = xlMedium
        .LineStyle = xlContinuous
    End With
    Selection.Shadow = False
    Selection.InvertIfNegative = False
    With Selection.Interior
        .ColorIndex = Color(c)
        .Pattern = xlSolid
    End With
          
Next j ' J

LegFini:

End Sub ' CvtChtToColumn