T
Takeadoe
Good morning - My title is working quite right. While font size is
correct (18 and 14 pt), the entire title is bold and I have no idea
why. I greatly appreciate it if you could take a look and see if you
see anything out of place. I don't want it bold.
Thanks so much.
Mike
Sub MinPopRelGoal()
Application.ScreenUpdating = False
Dim myList() As Variant
Dim i As Integer
Dim j As Integer
Dim myCount As Integer
Dim chtDeer As Chart
Dim shtData As Worksheet
Dim rngData As Range
Dim myDataSet As Range
Dim strCounty As String
myCount = 1
Set shtData = Worksheets("zPopTrends")
With shtData.Range("A2").CurrentRegion.Columns(1)
..AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ReDim myList(1 To .SpecialCells(xlCellTypeVisible).Count)
'MsgBox .SpecialCells(xlCellTypeVisible).Count
With .SpecialCells(xlCellTypeVisible)
For j = 1 To .Areas.Count
'MsgBox "There are " & .Areas.Count & " Areas"
'MsgBox "This is J " & .Areas(j).Address
For i = 1 To .Areas(j).Cells.Count
myList(myCount) = .Areas(j).Cells(i).Value
'MsgBox "This is CellsI " & .Areas(j).Cells(i).Value
'MsgBox myList(myCount)
myCount = myCount + 1
Next i
Next j
End With
ActiveSheet.ShowAllData
End With
Set myDataSet = shtData.Range("b2").CurrentRegion
'note that there is nothing significant about b2, the address of
the currrent
'region remains the same as long the cell in the range address is
somewhere in
'the first 67 rows and 3 columns
'MsgBox "This is the range address for mydataset " &
shtData.Range("b2").CurrentRegion.Address
For i = LBound(myList) + 1 To UBound(myList)
'MsgBox "Now doing " & myList(i) & " County"
shtData.Range("A2").AutoFilter Field:=1, Criteria1:=myList(i)
'This example filters a list starting in cell A1 on Sheet1 to
display only the
'entries in which field one is equal to the current value in the
array myList.
Set rngData = Intersect(myDataSet,
shtData.Range("c:E").SpecialCells(xlCellTypeVisible))
'MsgBox "This is the range address for rngData " & rngData.Address
strCounty = Trim(shtData.Range("A65536").End(xlUp).Value)
' make a chart
Set chtDeer = Charts.Add
With chtDeer
.ChartType = xlLineMarkers
.SetSourceData Source:=rngData, PlotBy:=xlColumns
.SeriesCollection(1).XValues = "=zPopTrends!R2C2:R18C2"
.Location Where:=xlLocationAsNewSheet
.HasTitle = True
.HasDataTable = True
.DataTable.ShowLegendKey = False
.Pictures.Insert( _
"C:\Documents and Settings\tonkovic\My Documents\Data Files
\Not Deer\OFFICE\WONotebooks2006Logo.jpg").Select
Selection.ShapeRange.IncrementLeft 500
'Selection.ShapeRange.IncrementLeft 5.1
With .ChartTitle
' .Characters.Text = strCounty & " County" & vbCr & " Antlerless Gun
Harvest Trends and Antlerless Opportunity Index (AOI), 1995-present"
.Characters.Text = strCounty & " County" & vbCr & " Minimum Prehunt
Deer Population " & vbCr & "Relative to Goal, 1995-2006"
.Characters(Start:=1, Length:=7 + Len(strCounty)).Font.Size = 18
.Characters(Start:=8 + Len(strCounty), Length:=84).Font.Size = 14
End With
.Axes(xlCategory).HasTitle = True
With .Axes(xlCategory).AxisTitle
.Characters.Text = "Year"
.Font.Name = "Arial"
.Font.Bold = True
.Font.Size = 14
End With
'With .Axes(xlCategory).TickLabels
' .Font.Name = "Arial"
' .Font.Bold = False
' .Font.Size = 12
'End With
.Axes(xlValue).HasTitle = True
With .Axes(xlValue).AxisTitle
.Characters.Text = "Minimum prehunt population (n)"
.Font.Name = "Arial"
.Font.Bold = True
.Font.Size = 13
End With
With .Axes(xlValue).TickLabels
.Font.Name = "Arial"
.Font.Bold = False
.Font.Size = 12
End With
.HasLegend = False
'With .Legend
' Position = xlBottom
' .Border.LineStyle = xlNone
' .Font.Name = "arial"
' .Font.Size = 12
'End With
With .PlotArea
.Interior.ColorIndex = xlNone
With .Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
End With
..Name = strCounty & " County Pop Trends"
End With
AddChtLegend
Next i
shtData.ShowAllData
Application.ScreenUpdating = True
End Sub
Sub AddChtLegend()
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.Legend.Select
ActiveChart.ChartArea.Select
ActiveChart.Legend.Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlNone
End With
Selection.Shadow = False
Selection.Interior.ColorIndex = xlAutomatic
End Sub
correct (18 and 14 pt), the entire title is bold and I have no idea
why. I greatly appreciate it if you could take a look and see if you
see anything out of place. I don't want it bold.
Thanks so much.
Mike
Sub MinPopRelGoal()
Application.ScreenUpdating = False
Dim myList() As Variant
Dim i As Integer
Dim j As Integer
Dim myCount As Integer
Dim chtDeer As Chart
Dim shtData As Worksheet
Dim rngData As Range
Dim myDataSet As Range
Dim strCounty As String
myCount = 1
Set shtData = Worksheets("zPopTrends")
With shtData.Range("A2").CurrentRegion.Columns(1)
..AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ReDim myList(1 To .SpecialCells(xlCellTypeVisible).Count)
'MsgBox .SpecialCells(xlCellTypeVisible).Count
With .SpecialCells(xlCellTypeVisible)
For j = 1 To .Areas.Count
'MsgBox "There are " & .Areas.Count & " Areas"
'MsgBox "This is J " & .Areas(j).Address
For i = 1 To .Areas(j).Cells.Count
myList(myCount) = .Areas(j).Cells(i).Value
'MsgBox "This is CellsI " & .Areas(j).Cells(i).Value
'MsgBox myList(myCount)
myCount = myCount + 1
Next i
Next j
End With
ActiveSheet.ShowAllData
End With
Set myDataSet = shtData.Range("b2").CurrentRegion
'note that there is nothing significant about b2, the address of
the currrent
'region remains the same as long the cell in the range address is
somewhere in
'the first 67 rows and 3 columns
'MsgBox "This is the range address for mydataset " &
shtData.Range("b2").CurrentRegion.Address
For i = LBound(myList) + 1 To UBound(myList)
'MsgBox "Now doing " & myList(i) & " County"
shtData.Range("A2").AutoFilter Field:=1, Criteria1:=myList(i)
'This example filters a list starting in cell A1 on Sheet1 to
display only the
'entries in which field one is equal to the current value in the
array myList.
Set rngData = Intersect(myDataSet,
shtData.Range("c:E").SpecialCells(xlCellTypeVisible))
'MsgBox "This is the range address for rngData " & rngData.Address
strCounty = Trim(shtData.Range("A65536").End(xlUp).Value)
' make a chart
Set chtDeer = Charts.Add
With chtDeer
.ChartType = xlLineMarkers
.SetSourceData Source:=rngData, PlotBy:=xlColumns
.SeriesCollection(1).XValues = "=zPopTrends!R2C2:R18C2"
.Location Where:=xlLocationAsNewSheet
.HasTitle = True
.HasDataTable = True
.DataTable.ShowLegendKey = False
.Pictures.Insert( _
"C:\Documents and Settings\tonkovic\My Documents\Data Files
\Not Deer\OFFICE\WONotebooks2006Logo.jpg").Select
Selection.ShapeRange.IncrementLeft 500
'Selection.ShapeRange.IncrementLeft 5.1
With .ChartTitle
' .Characters.Text = strCounty & " County" & vbCr & " Antlerless Gun
Harvest Trends and Antlerless Opportunity Index (AOI), 1995-present"
.Characters.Text = strCounty & " County" & vbCr & " Minimum Prehunt
Deer Population " & vbCr & "Relative to Goal, 1995-2006"
.Characters(Start:=1, Length:=7 + Len(strCounty)).Font.Size = 18
.Characters(Start:=8 + Len(strCounty), Length:=84).Font.Size = 14
End With
.Axes(xlCategory).HasTitle = True
With .Axes(xlCategory).AxisTitle
.Characters.Text = "Year"
.Font.Name = "Arial"
.Font.Bold = True
.Font.Size = 14
End With
'With .Axes(xlCategory).TickLabels
' .Font.Name = "Arial"
' .Font.Bold = False
' .Font.Size = 12
'End With
.Axes(xlValue).HasTitle = True
With .Axes(xlValue).AxisTitle
.Characters.Text = "Minimum prehunt population (n)"
.Font.Name = "Arial"
.Font.Bold = True
.Font.Size = 13
End With
With .Axes(xlValue).TickLabels
.Font.Name = "Arial"
.Font.Bold = False
.Font.Size = 12
End With
.HasLegend = False
'With .Legend
' Position = xlBottom
' .Border.LineStyle = xlNone
' .Font.Name = "arial"
' .Font.Size = 12
'End With
With .PlotArea
.Interior.ColorIndex = xlNone
With .Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
End With
..Name = strCounty & " County Pop Trends"
End With
AddChtLegend
Next i
shtData.ShowAllData
Application.ScreenUpdating = True
End Sub
Sub AddChtLegend()
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.Legend.Select
ActiveChart.ChartArea.Select
ActiveChart.Legend.Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlNone
End With
Selection.Shadow = False
Selection.Interior.ColorIndex = xlAutomatic
End Sub