VBA/Excel/Access/Word/Excel/Chart Format

Материал из VB Эксперт
Перейти к: навигация, поиск

Add Chart Sheet

   <source lang="vb">

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 

</source>


adds a light blue shadow to the box surrounding a legend:

   <source lang="vb">

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 

</source>


adds a line around the title and adds a glow around that line:

   <source lang="vb">

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 

</source>


Adds major gridlines, title, and x-axis labels to an embedded chart

   <source lang="vb">

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 

</source>


Applying chart formatting

   <source lang="vb">

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 

</source>


Background and Foreground color

   <source lang="vb">

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 

</source>


Changing a Chart Title Using VBA

   <source lang="vb">

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 

</source>


Changing the Bevel and 3-D Format

   <source lang="vb">

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 

</source>


creates the chart with absolute reference and format it

   <source lang="vb">

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 

</source>


defines a Chart object variable and a ChartGroup object variable and then stops:

   <source lang="vb">

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 

</source>


Format Axis, Title font size and color

   <source lang="vb">

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 

</source>


Format Soft Edges With Loop

   <source lang="vb">

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 

</source>


formats the trendline for the first series in a chart:

   <source lang="vb">

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 

</source>


Formatting a Basic Chart

   <source lang="vb">

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 

</source>


formatting a border

   <source lang="vb">

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 

</source>


Looping through the ChartObjects collection: changes the chart type of every embedded chart on the active sheet.

   <source lang="vb">

Sub ChartType() 

   Dim myChart As ChartObject
   For Each myChart In ActiveSheet.ChartObjects
       myChart.Chart.Type = xlArea
   Next myChart

End Sub 

</source>


Loop through each series in chart and alter marker colors

   <source lang="vb">

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 

</source>


Manipulating Charts

   <source lang="vb">

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 

</source>


Modifying chart properties: changes the Legend font for all charts on the active sheet.

   <source lang="vb">

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 

</source>


proper syntax for SoftEdge:

   <source lang="vb">

Sub Main() 

   Chart.Seriess(1).Points(i).Format.SoftEdge.Type = msoSoftEdgeType1

End Sub 

</source>


Set Axes gridline and its border color

   <source lang="vb">

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 

</source>


Set PlotArea LineStyle, border color, width and height

   <source lang="vb">

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 

</source>


sets up a two-color gradient using two theme colors:

   <source lang="vb">

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
</source>


To apply one of the 3-D rotation presets to a chart element: use the SetPresetCamera method

   <source lang="vb">

Sub Assign3DPreset() 

   Dim myChart As Chart
   Dim shp As Shape
   Set myChart = ActiveChart
   Set shp = myChart.Shapes(1)
   shp.ThreeD.SetPresetCamera msoCameraIsometricLeftDown

End Sub 

</source>


To fill the bars of a data series with a picture

   <source lang="vb">

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 

</source>


Working with a Chart Axis

   <source lang="vb">

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 

</source>


works on all the chart sheets in the active workbook

   <source lang="vb">

Sub ChartType2() 

   Dim myChart As Chart
   For Each myChart In ActiveWorkbook.Charts
       myChart.Type = xlArea
   Next myChart

End Sub 

</source>
Источник — «http://vbex.ru/index.php?title=VBA/Excel/Access/Word/Excel/Chart_Format&oldid=1651»