精华内容
下载资源
问答
  • 04VBA在EXCEL中的应用(窗体,控件).pdf
  • VBA在Excel中的应用用VBA将同一工作簿中不同工作表拆成独立文件问题描述1.在“开发工具”选项卡中选择”Visual Basic”2.插入模块运行结果可能存在的问题 用VBA将同一工作簿中不同工作表拆成独立文件 问题描述 有一...

    用VBA将同一工作簿中不同工作表拆成独立Excel文件

    问题描述

    有一个银行询证函的excel文件,里面包含了数十家公司总计一百多个的银行账户,每个银行账户都需要建立一份银行询证函,因此这份文件(即一个工作簿)中实际有近两百份的工作表,一个工作表就有可能是一份银行询证函,需要将每一个工作表都需要提取出来单独成立一份文件。由于数量众多,用VBA可以更快更有效率。
    数量众多的工作表

    1.在“开发工具”选项卡中选择”Visual Basic”

    在这里插入图片描述

    2.插入模块

    插入模块
    写入如下VBA代码:

    Sub saveworkbook()                                   '将sheet工作表批量另存为独立的工作簿,并命名成sheet表的名称
    
    Application.ScreenUpdating = False                   '关闭屏幕更新
    
    Dim ff As String                                     '定义字符变量                
    
    ff = ThisWorkbook.Path &"\new"                       '指定建立新的工作簿保存到的路径
    
    If Len(Dir(ff, vbDirectory)) = 0 Then MkDir ff       '如果new文件夹不存在,就新建文件夹;mkdir用来新建文件夹
    
    Dim st As Worksheet                                  '定义工作表变量                             
    
    For Each st In Worksheets                            '遍历所有的sheet工作表
    
      st.Copy                                            '拷贝sheet工作表到新的工作簿,即将工作表另存为新的文件。
    
      ActiveWorkbook.SaveAs ff & "\" & st.Name &".xlsx"  '保存工作簿,并命名成工作表的名称
    
      ActiveWorkbook.Close                               '关闭工作表
    
      Next                                               '执行遍历循环体
    
    Application.ScreenUpdating = True                    '开启屏幕更新
    
    End Sub
    

    注:在执行前要确保没有隐藏工作表,否则会提示错误:方法’Copy’作用于对象’_Worksheet’时失败

    运行报错

    运行结果

    新生成文件夹:
    新生成文件夹
    打开后:
    在这里插入图片描述
    里面就是之前工作簿中所有的工作表拆分出来各自形成单独的工作簿。

    可能存在的问题

    但实际情况可能不会这么简单,假如原工作簿大量使用了公式,而且是不同工作表之间存在数据耦合,那么直接拆解成独立文件后再打开很可能出现如下情况:
    错误
    这就需要将所有涉及到公式的地方全部只保留值。具体操作详见我的另一篇博文:
    VBA在Excel中的应用——用VBA将所有工作表去公式并保留原显示格式

    展开全文
  • VBA在Excel中的应用(一):改变符合条件单元格的背景颜色  在使用excel处理数据的时候,为了能更清晰的标示出满足特定条件的单元格,对单元格添加背景色是不错的选择。手工处理的方式简单快捷,但是当遇到大批量...

    Jiahua Jin

     

    VBA在Excel中的应用(一):改变符合条件单元格的背景颜色

      在使用excel处理数据的时候,为了能更清晰的标示出满足特定条件的单元格,对单元格添加背景色是不错的选择。手工处理的方式简单快捷,但是当遇到大批量数据,就会特别的费时费力,而且不讨好(容易出错)。通过代码来处理是个不错的选择,excel可以通过VBA编程来处理内部数据,在打开excel页面后,可以通过“alt + F11”组合键来启动VBA编程界面,跟VB的编程界面和语法一样,需要注意的是如何调用excel的内容。VBA通过sheet, range和cells三个层次来调用excel中的制定区域,sheet指定要处理的表格页,ranges制定要处理的范围,可以是一个单元格,也可以是多个单元格,cells(i,j)通过制定行下标i和列下表j来定位制定的单元格,通过这三个层次就基本能定位excel中的任意制定位置。

         关于vba和excel编程,请详见:http://msdn.microsoft.com/zh-cn/library/ee814737.aspx

                                                 http://www.cnblogs.com/jaxu/archive/2009/04/04/1407004.html

     

         实例:在做验证性因子分析(Confirmed Factoe Analysis,CFA)的时候,我们通常因子载荷(factor loading)来判断构念(construct)之间的区别效度(discriminant validity),即同一构念下的item之间correlation尽可能高,而不同构念的item之间的相关性尽可能低。所以将correlation matrix中大于没特定阈值单元格用特定背景颜色加以区分,就可以清晰的看出item之间的相关关系。

      假设我们有一个64*64的correlation matrix,那么在excel中是用vba对不同范围的correlation值的单元格添加背景颜色的代码如下:

    复制代码

     1 Sub changeBgColor()
     2   Dim i As Integer
     3   Dim j As Integer
     4   Dim r As Integer
     5   Dim c As Integer
     6   
     7   
     8   r = 67 '最后一行是第67行
     9   c = 66 '最后一列是第66列
    10   
    11   For i = 3 To r '迭代,从第3行开始,一直到最后一行
    12     For j = 2 To c  '迭代,从第2列开始,一直到最后一列
    13 
    14         If Cells(i, j) > 0.5 And Cells(i, j) < 0.6 Then  '如果单元格Cells(i,j)的值大于0.5下于0.6,那么背景颜色代码为42
    15             Cells(i, j).Interior.ColorIndex = 42
    16         End If
    17         
    18         If Cells(i, j) > 0.6 And Cells(i, j) < 0.7 Then
    19             Cells(i, j).Interior.ColorIndex = 43
    20         End If
    21         
    22         If Cells(i, j) > 0.7 And Cells(i, j) < 0.8 Then
    23             Cells(i, j).Interior.ColorIndex = 6
    24         End If
    25         
    26         If Cells(i, j) > 0.8 And Cells(i, j) < 1 Then
    27             Cells(i, j).Interior.ColorIndex = 3
    28         End If
    29     Next
    30   Next
    31   
    32 End Sub

    复制代码

      结果如下所示:

         

     

      附1:excel中的颜色代码(colorIndex)

      

    标签: VBAExcel数据可视化

    展开全文
  • VBA在Excel中的应用用VBA将所有工作表去公式并保留原显示格式问题描述1.在“开发工具”选项卡中选择”Visual Basic”2.插入模块运行结果 用VBA将所有工作表去公式并保留原显示格式 问题描述 出于各种各样的原因,...

    用VBA将所有工作表去公式并保留原显示格式

    问题描述

    出于各种各样的原因,我们需要将所有使用公式的单元格最后只留数值,而且要尽量保持显示格式不变。而使用公式的单元格零散分布,数量众多。因此,使用VBA会简化操作,提升效率。

    1.在“开发工具”选项卡中选择”Visual Basic”

    在这里插入图片描述

    2.插入模块

    插入模块
    写入如下VBA代码:

    Sub fmlatoval()
    
     Dim a As Worksheet
    
     For Each a In Sheets
    
     a.UsedRange.Copy                           'UsedRange表示所有被编辑过的单元格
    
     a.UsedRange.PasteSpecial xlPasteValues
    
     Application.CutCopyMode = False
    
     Next
    
    End Sub
    

    其实质相当于复制并保留原格式和值黏贴,和你自己弄复制黏贴差不多,只不过机器处理更快一些。

    这样就可以保证所有使用公式的单元格最后存储的只有数值,而且显示格式与原格式相同。

    运行结果

    运行前:
    在这里插入图片描述
    运行后:
    在这里插入图片描述
    因为原来这个单元格用的是VLOOKUP函数,而被搜所的值在另一张工作表里是用文本格式显示的,最终仍需要以文本格式展现。上述方法完全保留了原来的显示格式。如果仅仅只是粘贴值那么单元格就很有可能把值处理成数字格式,最后显示的结果就会用科学计数法显示。

    展开全文
  • 目录 Chart Export Chart Format Chart Lengend Chart Protect Chart Title Chart ...1. 将Excel中的图表导出成gif格式的图片保存到硬盘上 Sub ExportChart() Dim myChart As Chart Set myChart = Act...

    目录

    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


    返回目录

    转载于:https://www.cnblogs.com/jaxu/archive/2009/06/17/1505153.html

    展开全文
  • Column ComboBox Copy Paste CountA Evaluate Excel to XML Excel ADO Excel to Text File Excel Toolbar Column 1.选择整列 SubSelectEntireColumn()Selection.EntireColumn.SelectEndSub2...
  • 目录 AutoFilter Binding Cell Comments Cell Copy Cell Format ... 注意:旧版本中的Range.NoteText方法同样可以返回单元格中的Comment,按照Excel的帮助文档中的介绍,建议新版本中...
  • 将公式的表达式直接赋值给Formula属性,公式表达式可以参考Excel中的公式菜单,如求和、计数、求平均值等。 5. 获取当前活动单元格的地址 Sub selectRange() MsgBox ActiveCell.Address End Sub 地址...
  • VBA在Excel中的应用(一)

    千次阅读 2010-05-12 17:00:00
    将公式的表达式直接赋值给Formula属性,公式表达式可以参考Excel中的公式菜单,如求和、计数、求平均值等。 5. 获取当前活动单元格的地址 Sub selectRange()   MsgBox ActiveCell.Address End Sub ...
  • http://www.cnblogs.com/jaxu/archive/2009/04/30/1446619.html 
  • 将公式的表达式直接赋值给Formula属性,公式表达式可以参考Excel中的公式菜单,如求和、计数、求平均值等。 5. 获取当前活动单元格的地址 Sub selectRange()   MsgBox ActiveCell.Address End Sub 地址的格式...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 730
精华内容 292
关键字:

vba在excel中的应用