VBA/Excel/Access/Word/Excel/Chart Format — различия между версиями
Admin (обсуждение | вклад) м (1 версия) |
|
(нет различий)
|
Версия 16:33, 26 мая 2010
Содержание
- 1 Add Chart Sheet
- 2 adds a light blue shadow to the box surrounding a legend:
- 3 adds a line around the title and adds a glow around that line:
- 4 Adds major gridlines, title, and x-axis labels to an embedded chart
- 5 Applying chart formatting
- 6 Background and Foreground color
- 7 Changing a Chart Title Using VBA
- 8 Changing the Bevel and 3-D Format
- 9 creates the chart with absolute reference and format it
- 10 defines a Chart object variable and a ChartGroup object variable and then stops:
- 11 Format Axis, Title font size and color
- 12 Format Soft Edges With Loop
- 13 formats the trendline for the first series in a chart:
- 14 Formatting a Basic Chart
- 15 formatting a border
- 16 Looping through the ChartObjects collection: changes the chart type of every embedded chart on the active sheet.
- 17 Loop through each series in chart and alter marker colors
- 18 Manipulating Charts
- 19 Modifying chart properties: changes the Legend font for all charts on the active sheet.
- 20 proper syntax for SoftEdge:
- 21 Set Axes gridline and its border color
- 22 Set PlotArea LineStyle, border color, width and height
- 23 sets up a two-color gradient using two theme colors:
- 24 To apply one of the 3-D rotation presets to a chart element: use the SetPresetCamera method
- 25 To fill the bars of a data series with a picture
- 26 Working with a Chart Axis
- 27 works on all the chart sheets in the active workbook
Add Chart Sheet
Option Explicit
Public Sub AddChartSheet()
Dim aChart As Chart
Set aChart = Charts.Add
With aChart
.Name = "Mangoes"
.ChartType = xlColumnClustered
.SetSourceData Source:=Sheets("Sheet1").Range("A3:D7"), PlotBy:=xlRows
.HasTitle = True
.ChartTitle.Text = "=Sheet1!R3C1"
End With
End Sub
adds a light blue shadow to the box surrounding a legend:
Sub FormatShadow()
Dim myChart As Chart
Set myChart = ActiveChart
With myChart.Legend.Format.Shadow
.ForeColor.RGB = RGB(0, 0, 128)
.OffsetX = 5
.OffsetY = -3
.Transparency = 0.5
.Visible = True
End With
End Sub
adds a line around the title and adds a glow around that line:
Sub AddGlowToTitle()
Dim myChart As Chart
Set myChart = ActiveChart
myChart.ChartTitle.Format.Line.ForeColor.RGB = RGB(255, 255, 255)
myChart.ChartTitle.Format.Line.DashStyle = msoLineSolid
myChart.ChartTitle.Format.Glow.Color.ObjectThemeColor = msoThemeColorAccent6
myChart.ChartTitle.Format.Glow.Radius = 8
End Sub
Adds major gridlines, title, and x-axis labels to an embedded chart
Public Sub SetXAxis()
Dim myAxis As Axis
Set myAxis = ActiveSheet.ChartObjects(1).Chart.Axes(xlCategory, xlPrimary)
With myAxis "Set properties of x-axis
.HasMajorGridlines = True
.HasTitle = True
.AxisTitle.Text = "My Axis"
.AxisTitle.Font.Color = RGB(1, 2, 3)
.CategoryNames = Range("C2:C11")
.TickLabels.Font.Color = RGB(11, 12, 13)
End With
End Sub
Applying chart formatting
Sub ChartMods()
ActiveChart.Type = xlArea
ActiveChart.ChartArea.font.name = "Calibri"
ActiveChart.ChartArea.font.FontStyle = "Regular"
ActiveChart.ChartArea.font.Size = 9
ActiveChart.PlotArea.Interior.ColorIndex = xlNone
ActiveChart.Axes(xlValue).TickLabels.font.bold = True
ActiveChart.Axes(xlCategory).TickLabels.font.bold = True
ActiveChart.Legend.Position = xlBottom
End Sub
Background and Foreground color
Public Sub TestPoint()
Dim myPoint As Point
Set myPoint = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(3)
With myPoint
.ApplyDataLabels xlDataLabelsShowValue
.MarkerBackgroundColor = RGB(1, 2, 3)
.MarkerForegroundColor = RGB(11, 22, 33)
End With
End Sub
Changing a Chart Title Using VBA
Sub ApplyTexture()
Dim myChart As Chart
Dim ser As Series
Set myChart = ActiveChart
Set ser = myChart.SeriesCollection(2)
ser.Format.Fill.PresetTextured (msoTextureGreenMarble)
End Sub
Changing the Bevel and 3-D Format
Sub AssignBevel()
Dim myChart As Chart
Dim ser As Series
Set myChart = ActiveChart
Set ser = myChart.SeriesCollection(1)
ser.Format.ThreeD.Visible = True
ser.Format.ThreeD.BevelTopType = msoBevelCircle
ser.Format.ThreeD.BevelTopInset = 16
ser.Format.ThreeD.BevelTopDepth = 6
End Sub
creates the chart with absolute reference and format it
Sub CreateOHCLChart()
Dim myChart As Chart
Dim Ser As Series
ActiveSheet.Shapes.AddChart(xlLineMarkers).Select
Set myChart = ActiveChart
myChart.SetSourceData Source:=range("Sheet1!$A$1:$E$33")
With myChart.SeriesCollection(1)
.MarkerStyle = xlMarkerStylePicture
.Fill.UserPicture ("C:\dash.gif")
.Border.LineStyle = xlNone
.MarkerForegroundColorIndex = xlColorIndexNone
End With
With myChart.SeriesCollection(2)
.MarkerStyle = xlMarkerStyleNone
.Border.LineStyle = xlNone
End With
With myChart.SeriesCollection(3)
.MarkerStyle = xlMarkerStyleNone
.Border.LineStyle = xlNone
End With
" Format the Close series
Set Ser = myChart.SeriesCollection(4)
With Ser
.MarkerBackgroundColorIndex = 1
.MarkerForegroundColorIndex = 1
.MarkerStyle = xlDot
.MarkerSize = 9
.Border.LineStyle = xlNone
End With
" Add High-Low Lines
myChart.SetElement (msoElementLineHiLoLine)
myChart.SetElement (msoElementLegendNone)
End Sub
defines a Chart object variable and a ChartGroup object variable and then stops:
Sub ExploreChartElements()
Dim myChart As Chart
Dim myChartg As ChartGroup
Dim ser As Series
Set myChart = ActiveChart
Set myChartg = myChart.ChartGroups(1)
Set ser = myChart.SeriesCollection(1)
Stop
End Sub
Format Axis, Title font size and color
Sub FormattingCharts()
Dim myChart As Chart
Dim ws As Worksheet
Dim ax As Axis
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set myChart = GetChartByCaption(ws, "GDP")
If Not myChart Is Nothing Then
Set ax = myChart.Axes(xlCategory)
With ax
.AxisTitle.Font.Size = 12
.AxisTitle.Font.Color = vbRed
End With
End If
Set ax = Nothing
Set myChart = Nothing
Set ws = Nothing
End Sub
Function GetChartByCaption(ws As Worksheet, sCaption As String) As Chart
Dim myChart As ChartObject
Dim myChart As Chart
Dim sTitle As String
Set myChart = Nothing
For Each myChart In ws.ChartObjects
If myChart.Chart.HasTitle Then
sTitle = myChart.Chart.ChartTitle.Caption
If StrComp(sTitle, sCaption, vbTextCompare) = 0 Then
Set myChart = myChart.Chart
Exit For
End If
End If
Next
Set GetChartByCaption = myChart
Set myChart = Nothing
Set myChart = Nothing
End Function
Format Soft Edges With Loop
Sub FormatSoftEdgesWithLoop()
Dim myChart As Chart
Dim ser As Series
Set myChart = ActiveChart
Set ser = myChart.SeriesCollection(1)
For i = 1 To 6
ser.Points(i).Format.SoftEdge.Type = i
Next i
End Sub
formats the trendline for the first series in a chart:
Sub FormatLineOrBorders()
Dim myChart As Chart
Set myChart = ActiveChart
With myChart.SeriesCollection(1).Trendlines(1).Format.Line
.DashStyle = msoLineLongDashDotDot
.ForeColor.RGB = RGB(50, 0, 128)
.BeginArrowheadLength = msoArrowheadShort
.BeginArrowheadStyle = msoArrowheadOval
.BeginArrowheadWidth = msoArrowheadNarrow
.EndArrowheadLength = msoArrowheadLong
.EndArrowheadStyle = msoArrowheadTriangle
.EndArrowheadWidth = msoArrowheadWide
End With
End Sub
Formatting a Basic Chart
Sub FormattingCharts()
Dim myChart As Chart
Dim ws As Worksheet
Dim ax As Axis
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set myChart = GetChartByCaption(ws, "GDP")
If Not myChart Is Nothing Then
Set ax = myChart.Axes(xlCategory)
With ax
.AxisTitle.Font.Size = 12
.AxisTitle.Font.Color = vbRed
End With
Set ax = myChart.Axes(xlValue)
With ax
.HasMinorGridlines = True
.MinorGridlines.Border.LineStyle = xlDashDot
End With
With myChart.PlotArea
.Border.LineStyle = xlDash
.Border.Color = vbRed
.Interior.Color = vbWhite
.Width = myChart.PlotArea.Width + 10
.Height = myChart.PlotArea.Height + 10
End With
myChart.ChartArea.Interior.Color = vbWhite
myChart.Legend.Position = xlLegendPositionBottom
End If
Set ax = Nothing
Set myChart = Nothing
Set ws = Nothing
End Sub
Function GetChartByCaption(ws As Worksheet, sCaption As String) As Chart
Dim myChart As ChartObject
Dim myChart As Chart
Dim sTitle As String
Set myChart = Nothing
For Each myChart In ws.ChartObjects
If myChart.Chart.HasTitle Then
sTitle = myChart.Chart.ChartTitle.Caption
If StrComp(sTitle, sCaption, vbTextCompare) = 0 Then
Set myChart = myChart.Chart
Exit For
End If
End If
Next
Set GetChartByCaption = myChart
Set myChart = Nothing
Set myChart = Nothing
End Function
formatting a border
Sub FormatBorder()
Dim myChart As Chart
Set myChart = ActiveChart
With myChart.ChartArea.Format.Line
.DashStyle = msoLineLongDashDotDot
.ForeColor.RGB = RGB(50, 0, 128)
End With
End Sub
Looping through the ChartObjects collection: changes the chart type of every embedded chart on the active sheet.
Sub ChartType()
Dim myChart As ChartObject
For Each myChart In ActiveSheet.ChartObjects
myChart.Chart.Type = xlArea
Next myChart
End Sub
Loop through each series in chart and alter marker colors
Public Sub TestSeries()
Dim mySeries As Series
Dim seriesCol As SeriesCollection
Dim I As Integer
I = 1
Set seriesCol = ActiveSheet.ChartObjects(1).Chart.SeriesCollection
For Each mySeries In seriesCol
Set mySeries = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(I)
With mySeries
.MarkerBackgroundColor = RGB(1, 32, 43)
.MarkerForegroundColor = RGB(11, 32, 43)
.Border.Color = RGB(11, 12, 23)
End With
I = I + 1
Next
End Sub
Manipulating Charts
Public Sub ChartInterior()
Dim myChart As Chart
"Reference embedded chart
Set myChart = ActiveSheet.ChartObjects(1).Chart
With myChart "Alter interior colors of chart components
.ChartArea.Interior.Color = RGB(1, 2, 3)
.PlotArea.Interior.Color = RGB(11, 12, 1)
.Legend.Interior.Color = RGB(31, 32, 33)
If .HasTitle Then
.ChartTitle.Interior.Color = RGB(41, 42, 43)
End If
End With
End Sub
Modifying chart properties: changes the Legend font for all charts on the active sheet.
Sub LegendMod()
Dim myChart As ChartObject
For Each myChart In ActiveSheet.ChartObjects
With myChart.Chart.Legend.font
.name = "Calibri"
.FontStyle = "Bold"
.Size = 12
End With
Next myChart
End Sub
proper syntax for SoftEdge:
Sub Main()
Chart.Seriess(1).Points(i).Format.SoftEdge.Type = msoSoftEdgeType1
End Sub
Set Axes gridline and its border color
Sub FormattingCharts()
Dim myChart As Chart
Dim ws As Worksheet
Dim ax As Axis
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set myChart = GetChartByCaption(ws, "GDP")
If Not myChart Is Nothing Then
Set ax = myChart.Axes(xlValue)
With ax
.HasMinorGridlines = True
.MinorGridlines.Border.LineStyle = xlDashDot
End With
End If
Set ax = Nothing
Set myChart = Nothing
Set ws = Nothing
End Sub
Function GetChartByCaption(ws As Worksheet, sCaption As String) As Chart
Dim myChart As ChartObject
Dim myChart As Chart
Dim sTitle As String
Set myChart = Nothing
For Each myChart In ws.ChartObjects
If myChart.Chart.HasTitle Then
sTitle = myChart.Chart.ChartTitle.Caption
If StrComp(sTitle, sCaption, vbTextCompare) = 0 Then
Set myChart = myChart.Chart
Exit For
End If
End If
Next
Set GetChartByCaption = myChart
Set myChart = Nothing
Set myChart = Nothing
End Function
Set PlotArea LineStyle, border color, width and height
Sub FormattingCharts()
Dim myChart As Chart
Dim ws As Worksheet
Dim ax As Axis
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set myChart = GetChartByCaption(ws, "GDP")
If Not myChart Is Nothing Then
With myChart.PlotArea
.Border.LineStyle = xlDash
.Border.Color = vbRed
.Interior.Color = vbWhite
.Width = myChart.PlotArea.Width + 10
.Height = myChart.PlotArea.Height + 10
End With
End If
Set ax = Nothing
Set myChart = Nothing
Set ws = Nothing
End Sub
Function GetChartByCaption(ws As Worksheet, sCaption As String) As Chart
Dim myChart As ChartObject
Dim myChart As Chart
Dim sTitle As String
Set myChart = Nothing
For Each myChart In ws.ChartObjects
If myChart.Chart.HasTitle Then
sTitle = myChart.Chart.ChartTitle.Caption
If StrComp(sTitle, sCaption, vbTextCompare) = 0 Then
Set myChart = myChart.Chart
Exit For
End If
End If
Next
Set GetChartByCaption = myChart
Set myChart = Nothing
Set myChart = Nothing
End Function
sets up a two-color gradient using two theme colors:
Sub TwoColorGradient()
Dim myChart As Chart
Dim ser As Series
Set myChart = ActiveChart
Set ser = myChart.SeriesCollection(1)
MyPic = "C:\Title1.jpg"
ser.Format.Fill.TwoColorGradient msoGradientFromCorner, 3
ser.Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent6
ser.Format.Fill.BackColor.ObjectThemeColor = msoThemeColorAccent2
To apply one of the 3-D rotation presets to a chart element: use the SetPresetCamera method
Sub Assign3DPreset()
Dim myChart As Chart
Dim shp As Shape
Set myChart = ActiveChart
Set shp = myChart.Shapes(1)
shp.ThreeD.SetPresetCamera msoCameraIsometricLeftDown
End Sub
To fill the bars of a data series with a picture
Sub FormatWithPicture()
Dim myChart As Chart
Dim ser As Series
Set myChart = ActiveChart
Set ser = myChart.SeriesCollection(1)
MyPic = "C:\Title.jpg"
ser.Format.Fill.UserPicture (MyPic)
End Sub
Working with a Chart Axis
Sub chartAxis()
Dim myChartObject As ChartObject
Set myChartObject = ActiveSheet.ChartObjects.Add(Left:=200, Top:=200, _
Width:=400, Height:=300)
myChartObject.Chart.SetSourceData Source:= _
ActiveWorkbook.Sheets("Chart Data").Range("A1:E5")
myChartObject.SeriesCollection.Add Source:=ActiveSheet.Range("C4:K4"), Rowcol:=xlRows
myChartObject.SeriesCollection.NewSeries
myChartObject.HasTitle = True
With myChartObject.Axes(Type:=xlCategory, AxisGroup:=xlPrimary)
.HasTitle = True
.AxisTitle.Text = "Years"
.AxisTitle.Font.Name = "Times New Roman"
.AxisTitle.Font.Size = 12
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
End Sub
works on all the chart sheets in the active workbook
Sub ChartType2()
Dim myChart As Chart
For Each myChart In ActiveWorkbook.Charts
myChart.Type = xlArea
Next myChart
End Sub