Excel VBA常用技巧 第04章 shape及Chart对象要点.docx

1、Excel VBA常用技巧 第04章 shape及Chart对象要点VBA常用技巧目录 VBA常用技巧 1第4章 Shape（图形）、Chart（图表）对象 2技巧1 在工作表中添加图形 2技巧2 导出工作表中的图片 7技巧3 在工作表中添加艺术字 9技巧4 遍历工作表中的图形 11技巧5 移动、旋转图片 13技巧6 工作表中自动插入图片 14技巧7 固定工作表中图形的位置 17技巧8 使用VBA自动生成图表 19技巧9 使用独立窗口显示图表 23技巧10 导出工作表中的图表 24技巧11 多图表制作 25第4章 Shape（图形）、Chart（图表）对象技巧1 在工作表中添加图形如果需要在工

2、作表中添加图形对象，可以使用AddShape方法，如下面的代码所示。#001 Sub AddShape()#002 Dim myShape As Shape#003 On Error Resume Next#004 Sheet1.Shapes(myShape).Delete#005 Set myShape = Sheet1.Shapes.AddShape(msoShapeRectangle, 40, 120, 280, 30)#006 With myShape#007 .Name = myShape#008 With .TextFrame.Characters#009 .Text = 单击将选

3、择Sheet2!#010 With .Font#011 .Name = 华文行楷#012 .FontStyle = 常规#013 .Size = 22#014 .ColorIndex = 7#015 End With#016 End With#017 With .TextFrame #018 .HorizontalAlignment = -4108#019 .VerticalAlignment = -4108#020 End With#021 .Placement = 3#022 End With#023 myShape.Select#024 With Selection.ShapeRange

4、#025 With .Line#026 .Weight = 1#027 .DashStyle = msoLineSolid#028 .Style = msoLineSingle#029 .Transparency = 0#030 .Visible = msoTrue#031 .ForeColor.SchemeColor = 40#032 .BackColor.RGB = RGB(255, 255, 255)#033 End With#034 With .Fill#035 .Transparency = 0#036 .Visible = msoTrue#037 .ForeColor.Scheme

5、Color = 41#038 .OneColorGradient 1, 4, 0.23#039 End With#040 End With#041 Sheet1.Range(A1).Select#042 Sheet1.Hyperlinks.Add Anchor:=myShape, Address:=, _#043 SubAddress:=Sheet2!A1, ScreenTip:=选择Sheet2!#044 Set myShape = Nothing#045 End Sub代码解析：AddShape过程在工作表中添加一个矩形并设置其外观等属性。第2行代码声明变量myShape的对象类型。第3、

6、4行代码删除可能存在的名称为“myShape”的图形对象。第5行代码使用AddShape方法在工作表中添加一个矩形。当该方法应用于Shapes对象时，返回一个Shape对象，该对象代表工作表中的新自选图形，语法如下：expression.AddShape(Type, Left, Top, Width, Height)参数expression是必需的，返回一个Shapes对象。参数Type是必需的，指定要创建的自选图形的类型。参数Left和Top是必需的，以磅为单位给出自选图形边框左上角的位置。参数Width和Height是必需的，以磅为单位给出自选图形边框的宽度和高度。第7行代码将新建图形命名

7、为“myShape”，向Shapes集合添加新的图形时，将对新添加的图形赋以默认的名称，若要为图形指定更有意义的名称，可指定其Name属性。第8行到第16行代码为矩形添加文字，并设定其格式。其中第8行代码使用TextFrame 属性和Characters方法返回该矩形的字符区域。应用于Shape对象的TextFrame 属性返回一个TextFrame对象，该对象包含指定图形对象的对齐和定位属性；Characters方法返回一个Characters对象，该对象代表某个图形的文本框中的字符区域，语法如下：expression.Characters(Start, Length)参数expressio

8、n是必需的，返回一个指定文本框内Characters对象的表达式。参数Start是可选的，表示将要返回的第一个字符，如果此参数设置为 1 或被忽略，则Characters方法会返回以第一个字符为起始字符的字符区域。参数Length是可选的，表示要返回的字符个数。如果此参数被忽略，则Characters方法会返回该字符串的剩余部分（由Start参数指定的字符以后的所有字符）。第9行代码为矩形添加文字，应用于Characters对象的Text属性返回或设置对象的文本，为可读写的String类型。第10行到第15行代码设置矩形中文字的属性，应用于Characters对象Font属性返回一个Font对

9、象，该对象代表指定对象的字体属性（字体名称、字体大小、字体颜色等），第11行代码设置字体名称，第12行代码设置字体样式，第13行代码设置字体大小，第14行代码颜色。第17行到第20行代码设定矩形中文字的对齐方式。应用于TextFrame对象的HorizontalAlignment属性返回或设置指定对象的水平对齐方式，可为表格 531所示的XlHAlign常量之一。常量值描述xlHAlignCenter-4108居中xlHAlignCenterAcrossSelection7靠左xlHAlignDistributed-4117分散对齐xlHAlignFill5分散对齐xlHAlignGenera

10、l1靠左xlHAlignJustify-4130两端对齐xlHAlignLeft-4131靠左xlHAlignRight-4152靠右表格 531 HorizontalAlignment属性的XlHAlign常量应用于TextFrame对象的VerticalAlignment属性返回或设置指定对象的垂直对齐方式，可为表格 532所示的XlHAlign常量之一。常量值描述xlVAlignCenter-4108居中xlVAlignJustify-4130两端对齐xlVAlignBottom-4107靠下xlVAlignDistributed-4117分散对齐xlVAlignTop-4160靠上表格

11、 532 VerticalAlignment属性的XlHAlign常量第21行代码设置矩形大小和位置不随单元格而变，应用于Shape对象的Placement属性返回或设置对象与所在的单元格之间的附属关系，可为表格 533所示的XlPlacement常量之一。常量值描述xlFreeFloating3大小、位置均固定xlMove2大小固定、位置随单元格而变xlMoveAndSize1大小、位置随单元格而变表格 533 XlPlacement常量第24行到第32行代码设置矩形的边框线条格式，应用于ShapeRange集合的Line属性返回一个LineFormat 对象，该对象包含指定图形的线条格式属

12、性。其中第26行代码设置矩形线条粗细，第27行代码设置矩形线条的虚线样式，第28行代码设置矩形填充的透明度，第29行代码设置矩形为可见，第30行代码设置矩形的前景色，第31行代码设置矩形填充背景的颜色。第33行到第38行代码设置矩形的内部填充格式，应用于ShapeRange集合的Fill属性返回FillFormat对象，该对象包含指定的图表或图形的填充格式属性。其中第35行代码设置矩形内部的透明度，第36行代码设置矩形内部为可见，第37行代码设置矩形内部的前景色，第38行代码将矩形内部指定填充设为单色渐变，应用于 FillFormat对象的OneColorGradient方法将指定填充设为单色

13、渐变，语法如下：expression.OneColorGradient(Style, Variant, Degree)其中参数Style是必需的，底纹样式，可为表格 541所示的MsoGradientStyle常量之一。常量值描述msoGradientDiagonalDown4斜下msoGradientDiagonalUp3斜上msoGradientFromCenter7无msoGradientFromCorner5角部幅射msoGradientFromTitle6中心幅射msoGradientHorizontal1水平msoGradientMixed-2无msoGradientVertica

14、l2垂直表格 534 MsoGradientStyle常量参数Variant是必需的，渐变变量。取值范围为 1 到 4 之间，分别与“填充效果”对话框中“渐变”选项卡的四个渐变变量相对应。如果GradientStyle 设为 msoGradientFromCenter，则Variant参数只能设为 1 或 2。参数Degree是必需的，灰度。取值范围为 0.0（表示最深）到 1.0（表示最浅）之间。第42、43行代码为矩形对象添加超链接，应用于Hyperlinks对象的Add方法向指定的区域或图形添加超链接，语法如下：expression.Add(Anchor, Address, SubAdd

15、ress, ScreenTip, TextToDisplay)参数expression是必需的，返回一个Hyperlinks对象。参数Anchor是必需的，超链接的位置。可为Range对象或Shape对象。参数Address是必需的，超链接的地址。参数SubAddress是必需的，超链接的子地址。参数ScreenTip是可选的，当鼠标指针停留在超链接上时所显示的屏幕提示。参数TextToDisplay是可选的，要显示的超链接的文本。运行AddShape过程结果如图 531所示。图 531 在工作表中添加图形技巧2 导出工作表中的图片有时需要将工作表中的图形对象保存为单独的图像文件，可以使用Ex

16、port方法将工作表中的图片以文件形式导出，如下面的代码所示。#001 Sub ExportShp()#002 Dim Shp As Shape#003 Dim FileName As String#004 For Each Shp In Sheet1.Shapes#005 If Shp.Type = msoPicture Then#006 FileName = ThisWorkbook.Path & & Shp.Name & .gif#007 Shp.Copy#008 With Sheet1.ChartObjects.Add(0, 0, Shp.Width + 28, Shp.Height

17、+ 30).Chart#009 .Paste#010 .Export FileName, gif#011 .Parent.Delete#012 End With#013 End If#014 Next#015 End Sub代码解析：ExportShp过程将Sheet1工作表的所有图片以文件形式导出到同一目录中。第4行代码使用For Each.Next 语句遍历Sheet1工作表中的所有图形。第5行代码判断图形的类型是否为图片，应用于Shape对象的Type属性返回或设置图形类型，可以为表格 541所示的MsoShapeType常量之一。常量值说明msoShapeTypeMixed-2混合型图

18、形msoAutoShape1自选图形msoCallout2没有边框线的标注msoChart3图表msoComment4批注msoFreeform5任意多边形msoGroup6图形组合msoFormControl8窗体控件msoLine9线条msoLinkedOLEObject10链接式或内嵌OLE对象msoLinkedPicture11剪贴画或图片msoOLEControlObject12ActiveX 控件msoPicture13图片msoTextEffect15艺术字msoTextBox17文本框msoDiagram21组织结构图或其他图示表格 541 MsoShapeType常量第6行代

19、码使用字符串变量FileName记录需导出图形的路径和名称。第7行代码复制图形，应用于Shape对象的Copy方法将对象复制到剪贴板。第8行代码使用Add方法在工作表中添加一个图表，应用于ChartObjects对象的Add 方法创建新的嵌入图表，语法如下：expression.Add(Left, Top, Width, Height)参数expression是必需的，返回一个ChartObjects对象。参数Left、参数Top是必需的，以磅为单位给出新对象的初始坐标，该坐标是相对于工作表上单元格A1的左上角或图表的左上角的坐标。参数Width、参数Height是必需的，以磅为单位给出新对象

20、的初始大小。第9行代码使用Paste方法将图形粘贴到新的嵌入图表中，应用于Chart对象的Paste方法将剪贴板中的图表数据粘贴到指定的图表中，语法如下：expression.Paste(Type)参数expression是必需的，返回一个Chart对象。参数Type是可选的的，如果剪贴板中有图表，本参数指定要粘贴的图表信息。可为以下XlPasteType常量之一：xlFormats、xlFormulas或xlAll。默认值为xlAll，如果剪贴板中是数据不是图表，则不能使用本参数。第10行代码使用Export方法将图表导出到同一目录中，应用于Chart对象的Export方法以图形格式导出图表

21、，语法如下：expression.Export(Filename, FilterName, Interactive)其中参数Filename是必需的，被导出的文件的名称。第10行代码删除新建的图表。因为Chart对象是不能使用Delete方法直接删除的，应先使用Parent属性返回指定对象的父对象，然后使用Delete方法删除。技巧3 在工作表中添加艺术字在工作表中插入艺术字，可以使用AddTextEffect方法，如下面的代码所示。#001 Sub TextEffect()#002 Dim myShape As Shape#003 On Error Resume Next#004 Sheet

22、1.Shapes(myShape).Delete#005 Set myShape = Sheet1.Shapes.AddTextEffect _#006 (PresetTextEffect:=msoTextEffect15, _#007 Text:=我爱 Excel Home, FontName:=宋体, FontSize:=36, _#008 FontBold:=msoFalse, FontItalic:=msoFalse, _#009 Left:=100, Top:=100)#010 With myShape#011 .Name = myShape#012 With .Fill#013 .

23、Solid#014 .ForeColor.SchemeColor = 55#015 .Transparency = 0#016 End With#017 With .Line#018 .Weight = 1.5#019 .DashStyle = msoLineSolid#020 .Style = msoLineSingle#021 .Transparency = 0#022 .ForeColor.SchemeColor = 12#023 .BackColor.RGB = RGB(255, 255, 255)#024 End With#025 End With#026 Set myShape =

24、 Nothing#027 End Sub代码解析：TextEffect过程在工作表中插入艺术字并设置其格式。第3、4行代码删除工作表中可能存在的艺术字，以免重复添加。第5行到第9行代码使用AddTextEffect方法在工作表中插入艺术字，AddTextEffect方法创建艺术字对象。返回一个Shape对象，该对象代表新建的艺术字对象，语法如下：expression.AddTextEffect(PresetTextEffect, Text, FontName, FontSize, FontBold, FontItalic, Left, Top)参数expression是必需的，返回一个Shap

25、es对象。参数PresetTextEffect是必需的，艺术字预置文本效果，可为MsoPresetTextEffect 常量之一，等同于在工作表中插入艺术字时的样式选项卡，如图 551所示。图 551 艺术字样式参数Text是必需的，艺术字对象中的文字。参数FontName是必需的，艺术字对象中所用的字体名称。参数FontSize是必需的，以磅为单位给出艺术字对象中所用的字体大小。参数FontBold是必需的，在艺术字中要加粗的字体。参数FontItalic是必需的，在艺术字中要倾斜的字体。参数Left和参数Top是必需的，相对于文档的左上角、顶部，以磅为单位给出艺术字对象边框左上角的位置。第

26、11行代码将艺术字对象重命名为“myShape”。第12行到第16行代码设置艺术字对象的填充格式。其中第13行代码将填充格式设置为均一的颜色，应用于FillFormat 对象的Solid方法将指定的填充格式设置为均一的颜色，可用本方法将带有渐进色、纹理、图案或背景的填充格式转换为单色的填充格式。第14行代码设置填充的颜色。第15行代码设置填充的透明度。第17行到第24行代码设置艺术字对象的线条格式属性。其中第18行代码设置线条粗细，第19行代码设置线条虚线样式，第20行代码设置线条区域的样式，第21行代码设置线条的透明度，第22行代码设置前景色，第23行代码设置填充背景的颜色。运行TextEf

27、fect过程工作表中如图 552所示。图 552 工作表中插入艺术字技巧4 遍历工作表中的图形工作表中的多个图形，如果使用系统缺省名称，如“文本框1”、“文本框2”这样前面是固定的字符串，后面是序号的，可以使用For.Next 语句遍历图形，如下面的代码所示。#001 Sub ErgShapes_1()#002 Dim i As Integer#003 For i = 1 To 4#004 Sheet1.Shapes(文本框 & i).TextFrame.Characters.Text = #005 Next#006 End Sub代码解析：ErgShapes_1过程清除工作表中四个图形文本框

28、中的文字。第3行到第5行代码，使用Shapes属性在工作表上的三个图形文本框中循环。Shapes属性返回Shapes对象，代表工作表或图形工作表上的所有图形，可以使用Shapes（index）返回单个的Shape对象，其中index是图形的名称或索引号。返回单个的Shape对象后使用TextFrame 属性和Characters方法清除文本框中的字符，关于Shape对象的TextFrame 属性和Characters方法请参阅技巧53 。如果图形的名称没有规律，可以使用For Each.Next 语句循环遍历所有图形，根据Type属性返回的图形类型进行相应的操作，如下面的代码所示。#001 S

29、ub ErgShapes_2()#002 Dim myShape As Shape#003 Dim i As Integer#004 i = 1#005 For Each myShape In Sheet1.Shapes#006 If myShape.Type = msoTextBox Then#007 myShape.TextFrame.Characters.Text = 这是第 & i & 个文本框#008 i = i + 1#009 End If#010 Next#011 End Sub代码解析：ErgShapes_2过程在工作表中的所有图形文本框中写入文本。第5行代码使用For Eac

30、h.Next 语句循环遍历工作表中所有的图形对象。第6行到第9行代码如果图形对象是文本框则在文本框中写入文本。其中第6行代码根据Type属性判断图形对象是否为文本框，应用于Shape对象的Type属性返回或设置图形类型，MsoShapeType类型，请参阅表格 541 。第7行代码根据返回的Type属性值在所有的文本框内写入相应的文本，如图 561所示。图 561 遍历所有的文本框技巧5 移动、旋转图片工作表中的图片可以移动、旋转，如下面的代码所示。#001 Sub MoveShape()#002 Dim i As Long#003 Dim j As Long#004 With Sheet1.Shapes(1)#005 For i = 1 To 3000 Step 5#006 .Top = Sin(i * (3.1416 / 180) * 100 + 100