zoukankan      html  css  js  c++  java
  • VBA在Excel中的应用(三)

    目录

    Chart Export
    Chart Format
    Chart Lengend
    Chart Protect
    Chart Title
    Chart

    Chart Export

    1. 1. 将Excel中的图表导出成gif格式的图片保存到硬盘上
      Sub ExportChart()
         
      Dim myChart As Chart
         
      Set myChart = ActiveChart
          myChart.Export Filename:
      ="C:\Chart.gif", Filtername:="GIF"
      End Sub
      理论上图表可以被保存成任何类型的图片文件,读者可以自己去尝试。
    2. 2. 将Excel中的图表导出成可交互的页面保存到硬盘上
      Sub SaveChartWeb()
          ActiveWorkbook.PublishObjects.Add _
              SourceType:
      =xlSourceChart, _
              Filename:
      =ActiveWorkbook.Path & "\Sample2.htm", _
              Sheet:
      =ActiveSheet.name, _
              Source:
      =" Chart 1", _
              HtmlType:
      =xlHtmlChart

          ActiveWorkbook.PublishObjects(
      1).Publish (True)
      End Sub


    返回目录

     Chart Format

    1. 1. 操作Chart对象。给几个用VBA操作Excel Chart对象的例子,读者可以自己去尝试一下。
      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

      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

      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

      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

      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

      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
    2. 2. 使用VBA在Excel中添加图表
      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
    3. 3. 遍历并更改Chart对象中的图表类型
      Sub ChartType()
         
      Dim myChart As ChartObject
         
      For Each myChart In ActiveSheet.ChartObjects
              myChart.Chart.Type
      = xlArea
         
      Next myChart
      End Sub
    4. 4. 遍历并更改Chart对象中的Legend
      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
    5. 5. 一个格式化Chart的例子
      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
    6. 6. 通过VBA更改Chart的Title
      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
    7. 7. 在VBA中使用自定义图片填充Chart对象的series区域
      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
      Excel中的Chart允许用户对其中选定的区域自定义样式,其中包括使用图片选中样式。在Excel的Layout菜单下有一个Format Selection,首先在Chart对象中选定要格式化的区域,例如series,然后选择该菜单,在弹出的对话框中即可对所选的区域进行格式化。如series选项、填充样式、边框颜色和样式、阴影以及3D效果等。下面再给出一个在VBA中使用渐变色填充Chart对象的series区域的例子。
      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
      End Sub
    8. 8. 通过VBA格式化Chart对象中series的趋势线样式
      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
      Excel允许用户为Chart对象的series添加趋势线(trendline),首先在Chart中选中要设置的series,然后选择Layout菜单下的trendline,选择一种trendline样式。
    9. 9. 一组利用VBA格式化Chart对象的例子
      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

      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

      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

      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
    10. 10. 在VBA中对Chart对象应用3D效果
      Sub Assign3DPreset()
         
      Dim myChart As Chart
         
      Dim shp As Shape
         
      Set myChart = ActiveChart
         
      Set shp = myChart.Shapes(1)
          shp.ThreeD.SetPresetCamera msoCameraIsometricLeftDown
      End Sub

      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


    返回目录

     Chart Lengend

    1. 1. 设置Lengend的位置和ChartArea的颜色
      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
              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
    2. 2. 通过VBA给Chart添加Lengend
      Sub legend()
         
      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
         
      With myChartObject.Legend
              .HasLegend
      = True
              .Font.Size
      = 16
              .Font.Name
      = "Arial"
         
      End With
      End Sub


    返回目录

     Chart Protect

    1. 1. 保护图表
      Sub ProtectChart()
         
      Dim myChart As Chart
         
      Set myChart = ThisWorkbook.Sheets("Protected Chart")
          myChart.Protect
      "123456", True, True, , True
          myChart.ProtectData
      = False
          myChart.ProtectGoalSeek
      = True
          myChart.ProtectSelection
      = True
      End Sub
      Excel中的Chart可以和Sheet一样被保护,读者可以选中图表所在的Tab,然后通过Review菜单下的Protect Sheet菜单来对图表进行保护设置。代码中的Protected Chart123456是设置保护时的密码,有关Protect函数的参数和设置保护时的其它属性读者可以查阅Excel自带的帮助文档。
    2. 2. 取消图表保护
      Sub UnprotectChart()
         
      Dim myChart As Chart
         
      Set myChart = ThisWorkbook.Sheets("Protected Chart")
          myChart.Unprotect
      "123456"
          myChart.ProtectData
      = False
          myChart.ProtectGoalSeek
      = False
          myChart.ProtectSelection
      = False
      End Sub
      与保护图表的示例相对应,可以通过VBA撤销对图表的保护设置。 


    返回目录

     Chart Title

    1. 1. 通过VBA添加图表的标题
      Sub chartTitle()
         
      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
      End Sub
      如果要设置标题显示的位置,可以在上述代码的后面加上:
      With myChartObject.ChartTitle
         .Top = 100
         .Left = 150
      End With
      如果要同时设置标题字体,可以在上述代码的后面加上:
      myChartObject.ChartTitle.Font.Name = "Times"
    2. 2. 通过VBA修改图表的标题
      Sub charTitleText()
          ActiveChart.ChartTitle.Text
      = "Industrial Disease in North Dakota"
      End Sub
    3. 3. 一个通过标题搜索图表的例子
      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
      Sub TestGetChartByCaption()
         
      Dim myChart As Chart
         
      Dim ws As Worksheet
         
      Set ws = ThisWorkbook.Worksheets("Sheet1")
         
      Set myChart = GetChartByCaption(ws, "I am the Chart Title")

         
      If Not myChart Is Nothing Then
              Debug.Print
      "Found chart"
         
      Else
              Debug.Print
      "Sorry - chart not found"
         
      End If

         
      Set ws = Nothing
         
      Set myChart = Nothing
      End Sub


    返回目录

     Chart

    1. 1. 通过VBA创建Chart的几种方式
      使用ChartWizard方法创建
      Sub CreateExampleChartVersionI() 
         
      Dim ws As Worksheet 
         
      Dim rgChartData As Range 
         
      Dim myChart As Chart 

         
      Set ws = ThisWorkbook.Worksheets("Sheet1"
         
      Set rgChartData = ws.Range("B1").CurrentRegion 
         
      Set myChart = Charts.Add 
         
      Set myChart = myChart.Location(xlLocationAsObject, ws.Name) 
         
      With myChart 
              .ChartWizard _ 
                  Source:
      =rgChartData, _ 
                  Gallery:
      =xlColumn, _ 
                  Format:
      =1, _ 
                  PlotBy:
      =xlColumns, _ 
                  CategoryLabels:
      =1, _ 
                  SeriesLabels:
      =1, _ 
                  HasLegend:
      =True, _ 
                  Title:
      ="Version I", _ 
                  CategoryTitle:
      ="Year", _ 
                  ValueTitle:
      ="GDP in billions of $" 
         
      End With 

         
      Set myChart = Nothing 
         
      Set rgChartData = Nothing 
         
      Set ws = Nothing 
      End Sub
      使用Chart Object方法创建
      Sub CreateExampleChartVersionII() 
         
      Dim ws As Worksheet 
         
      Dim rgChartData As Range 
         
      Dim myChart As Chart 

         
      Set ws = ThisWorkbook.Worksheets("Basic Chart"
         
      Set rgChartData = ws.Range("B1").CurrentRegion 
         
      Set myChart = Charts.Add 
         
      Set myChart = myChart.Location(xlLocationAsObject, ws.Name) 

         
      With myChart 
              .SetSourceData rgChartData, xlColumns 
              .HasTitle
      = True 
              .ChartTitle.Caption
      = "Version II" 
              .ChartType
      = xlColumnClustered 

             
      With .Axes(xlCategory) 
                  .HasTitle
      = True 
                  .AxisTitle.Caption
      = "Year" 
             
      End With 

             
      With .Axes(xlValue) 
                  .HasTitle
      = True 
                  .AxisTitle.Caption
      = "GDP in billions of $" 
             
      End With 

         
      End With 

         
      Set myChart = Nothing 
         
      Set rgChartData = Nothing 
         
      Set ws = Nothing 
      End Sub
      使用ActiveWorkbook.Sheets.Add方法创建
      Sub chart()
         
      Dim myChartSheet As Chart
         
      Set myChartSheet = ActiveWorkbook.Sheets.Add _
              (After:
      =ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count), _
              Type:
      =xlChart)
      End Sub
      使用ActiveSheet.ChartObjects.Add方法创建
      Sub charObj()
         
      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")
      End Sub
      不同的创建方法可以应用在不同的场合,如Sheet中内嵌的图表,一个独立的Chart Tab等,读者可以自己研究。最后一种方法的末尾给新创建的图表设定了数据源,这样图表就可以显示出具体的图形了。
      如果需要指定图表的类型,可以加上这句代码:
      myChartObject.ChartType = xlColumnStacked
      如果需要在现有图表的基础上添加新的series,下面这行代码可以参考:
      myChartObject.SeriesCollection.Add Source:=ActiveSheet.Range("C4:K4"), Rowcol:=xlRows
      或者通过下面这行代码对已有的series进行扩展:
      myChartObject.SeriesCollection.Extend Source:=Worksheets("Chart Data").Range("P3:P8")
    2. 2. 一个相对完整的通过VBA创建Chart的例子
      'Common Excel Chart Types     
      '
      -------------------------------------------------------------------  
      '
      Chart   |   VBA Constant (ChartType property of Chart object)     |
      '
      ==================================================================       
      '
      Column  |   xlColumnClustered, xlColumnStacked, xlColumnStacked100|        
      '
      Bar     |   xlBarClustered, xlBarStacked, xlBarStacked100         |
      '
      Line    |   xlLine, xlLineMarkersStacked, xlLineStacked           |
      '
      Pie     |   xlPie, xlPieOfPie                                     |
      '
      Scatter |   xlXYScatter, xlXYScatterLines                         |
      '
      -------------------------------------------------------------------

      Public Sub AddChartSheet()
         
      Dim dataRange As Range
         
      Set dataRange = ActiveWindow.Selection
          Charts.Add  
      'Create a chart sheet
          With ActiveChart    'Set chart properties
              .ChartType = xlColumnClustered
              .HasLegend
      = True
              .Legend.Position
      = xlRight

              .Axes(xlCategory).MinorTickMark
      = xlOutside
              .Axes(xlValue).MinorTickMark
      = xlOutside
              .Axes(xlValue).MaximumScale
      = _
                          Application.WorksheetFunction.RoundUp( _
                          Application.WorksheetFunction.Max(dataRange),
      -1)
              .Axes(xlCategory).HasTitle
      = True
              .Axes(xlCategory).AxisTitle.Characters.Text
      = "X-axis Labels"
              .Axes(xlValue).HasTitle
      = True
              .Axes(xlValue).AxisTitle.Characters.Text
      = "Y-axis"

              .SeriesCollection(
      1).name = "Sample Data"
              .SeriesCollection(
      1).Values = dataRange
         
      End With
      End Sub
    3. 3. 通过选取的Cells Range的值设置Chart中数据标签的内容
      Sub DataLabelsFromRange()
         
      Dim DLRange As range
         
      Dim myChart As Chart
         
      Dim i As Integer
          
         
      Set myChart = ActiveSheet.ChartObjects(1).Chart
         
      On Error Resume Next
         
      Set DLRange = Application.InputBox _
            (prompt:
      ="Range for data labels?", Type:=8)
         
      If DLRange Is Nothing Then Exit Sub
         
      On Error GoTo 0
          myChart.SeriesCollection(
      1).ApplyDataLabels Type:=xlDataLabelsShowValue, AutoText:=True, LegendKey:=False
          Pts
      = myChart.SeriesCollection(1).Points.Count
         
      For i = 1 To Pts
              myChart.SeriesCollection(
      1). _
                Points(i).DataLabel.Characters.Text
      = DLRange(i)
         
      Next i
      End Sub
      考虑下面这个场景,当采用下表的数据生成图表Chart4时,默认的效果如下图。

          可以手动给该图表添加Data Labels,方法是选中任意的series,右键选择Add Data Labels。如果想要为所有的series添加Data Labels,则需要依次选择不同的series,然后重复该操作。
          Excel中可以通过VBA将指定Cells Range中的值设置到Chart的Data Labels中,上面的代码就是一个例子。程序执行的时候会首先弹出一个提示框,要求用户通过鼠标去选择一个单元格区域以获取到Cells集合(或者直接输入地址),如下图:
      6-17-2009 3-42-28 PM    注意VBA中输入型对话框Application.InputBox的使用。在循环中将Range中的值添加到Chart的Data Labels中。
    4. 4. 一个使用VBA给Chart添加Data Labels的例子
      Sub AddDataLabels()
          
      Dim seSales As Series
          
      Dim pts As Points
          
      Dim pt As Point
          
      Dim rngLabels As range
          
      Dim iPointIndex As Integer

          
      Set rngLabels = range("B4:G4")

          
      Set seSales = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
          seSales.HasDataLabels 
      = True

          
      Set pts = seSales.Points

          
      For Each pt In pts
              iPointIndex 
      = iPointIndex + 1
              pt.DataLabel.text 
      = rngLabels.cells(iPointIndex).text
              pt.DataLabel.font.bold 
      = True
              pt.DataLabel.Position 
      = xlLabelPositionAbove
          
      Next pt
      End Sub


    返回目录

  • 相关阅读:
    webpack 模块化 原理
    nodejs 程序 调试
    inno打包教程
    原生xhr、fetch 请求的拦截。mock 技术原理
    package.json 字段说明
    npm 依赖包 的管理【即 node_modules目录的设计原理】
    现在浏览器、webview 中 css的兼容性问题。
    安卓APP(H5本地打包apk应用)
    npm 脚本
    linux系统 离线安装node和nginx(即npm包)
  • 原文地址:https://www.cnblogs.com/jaxu/p/1505153.html
Copyright © 2011-2022 走看看