ExcelVBA处理图形图表.docx

1、ExcelVBA处理图形图表Shape图形、Chart图表对象在工作表中添加图形如果需要在工作表中添加图形对象，可以使用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#0

2、09 .Text = 单击将选择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#025 With .Line#026 .Weight = 1#027

3、 .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.SchemeColor = 41#039 End With#040 End Wit

4、h#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、4行代码删除可能存在的名称为“myShape的图形对象。第5行代码使用AddShape方法在工作表中添加一个矩形。当该方法应用于Shap

5、es对象时，返回一个Shape对象，该对象代表工作表中的新自选图形，语法如下：expression.AddShape(Type, Left, Top, Width, Height)参数expression是必需的，返回一个Shapes对象。参数Type是必需的，指定要创建的自选图形的类型。参数Left和Top是必需的，以磅为单位给出自选图形边框左上角的位置。参数Width和Height是必需的，以磅为单位给出自选图形边框的宽度和高度。第7行代码将新建图形命名为“myShape，向Shapes集合添加新的图形时，将对新添加的图形赋以默认的名称，假如要为图形指定更有意义的名称，可指定其Name属性

6、。第8行到第16行代码为矩形添加文字，并设定其格式。其中第8行代码使用TextFrame 属性和Characters方法返回该矩形的字符区域。应用于Shape对象的TextFrame 属性返回一个TextFrame对象，该对象包含指定图形对象的对齐和定位属性；Characters方法返回一个Characters对象，该对象代表某个图形的文本框中的字符区域，语法如下：expression.Characters(Start, Length)参数expression是必需的，返回一个指定文本框内Characters对象的表达式。参数Start是可选的，表示将要返回的第一个字符，如果此参数设置为 1

7、或被忽略，如此Characters方法会返回以第一个字符为起始字符的字符区域。参数Length是可选的，表示要返回的字符个数。如果此参数被忽略，如此Characters方法会返回该字符串的剩余局部由Start参数指定的字符以后的所有字符。第9行代码为矩形添加文字，应用于Characters对象的Text属性返回或设置对象的文本，为可读写的String类型。第10行到第15行代码设置矩形中文字的属性，应用于Characters对象Font属性返回一个Font对象，该对象代表指定对象的字体属性字体名称、字体大小、字体颜色等，第11行代码设置字体名称，第12行代码设置字体样式，第13行代码设置字体大

8、小，第14行代码颜色。第17行到第20行代码设定矩形中文字的对齐方式。应用于TextFrame对象的HorizontalAlignment属性返回或设置指定对象的水平对齐方式，可为表格 531所示的XlHAlign常量之一。常量值描述xlHAlignCenter-4108居中xlHAlignCenterAcrossSelection7靠左xlHAlignDistributed-4117分散对齐xlHAlignFill5分散对齐xlHAlignGeneral1靠左xlHAlignJustify-4130两端对齐xlHAlignLeft-4131靠左xlHAlignRight-4152靠右表格 5

9、31HorizontalAlignment属性的XlHAlign常量应用于TextFrame对象的VerticalAlignment属性返回或设置指定对象的垂直对齐方式，可为表格 532所示的XlHAlign常量之一。常量值描述xlVAlignCenter-4108居中xlVAlignJustify-4130两端对齐xlVAlignBottom-4107靠下xlVAlignDistributed-4117分散对齐xlVAlignTop-4160靠上表格 532VerticalAlignment属性的XlHAlign常量第21行代码设置矩形大小和位置不随单元格而变，应用于Shape对象的Plac

10、ement属性返回或设置对象与所在的单元格之间的附属关系，可为表格 533所示的XlPlacement常量之一。常量值描述xlFreeFloating3大小、位置均固定xlMove2大小固定、位置随单元格而变xlMoveAndSize1大小、位置随单元格而变表格 533XlPlacement常量第24行到第32行代码设置矩形的边框线条格式，应用于ShapeRange集合的Line属性返回一个LineFormat 对象，该对象包含指定图形的线条格式属性。其中第26行代码设置矩形线条粗细，第27行代码设置矩形线条的虚线样式，第28行代码设置矩形填充的透明度，第29行代码设置矩形为可见，第30行代码

11、设置矩形的前景色，第31行代码设置矩形填充背景的颜色。第33行到第38行代码设置矩形的内部填充格式，应用于ShapeRange集合的Fill属性返回FillFormat对象，该对象包含指定的图表或图形的填充格式属性。其中第35行代码设置矩形内部的透明度，第36行代码设置矩形内部为可见，第37行代码设置矩形内部的前景色，第38行代码将矩形内部指定填充设为单色渐变，应用于 FillFormat对象的OneColorGradient方法将指定填充设为单色渐变，语法如下：expression.OneColorGradient(Style, Variant, Degree)其中参数Style是必需的，底

12、纹样式，可为表格 541所示的MsoGradientStyle常量之一。常量值描述msoGradientDiagonalDown4斜下msoGradientDiagonalUp3斜上msoGradientFromCenter7无msoGradientFromCorner5角部幅射msoGradientFromTitle6中心幅射msoGradientHorizontal1水平msoGradientMixed-2无msoGradientVertical2垂直表格 534MsoGradientStyle常量参数Variant是必需的，渐变变量。取值X围为 1 到 4 之间，分别与“填充效果对话框中

13、“渐变选项卡的四个渐变变量相对应。如果GradientStyle 设为 msoGradientFromCenter，如此Variant参数只能设为 1 或 2。参数Degree是必需的，灰度。取值X围为 0.0表示最深到 1.0表示最浅之间。第42、43行代码为矩形对象添加超，应用于Hyperlinks对象的Add方法向指定的区域或图形添加超，语法如下：expression.Add(Anchor, Address, SubAddress, ScreenTip, TextToDisplay)参数expression是必需的，返回一个Hyperlinks对象。参数Anchor是必需的，超的位置。可

14、为Range对象或Shape对象。参数Address是必需的，超的地址。参数SubAddress是必需的，超的子地址。参数ScreenTip是可选的，当鼠标指针停留在超上时所显示的屏幕提示。参数TextToDisplay是可选的，要显示的超的文本。运行AddShape过程结果如图 531所示。图 531在工作表中添加图形技巧1 导出工作表中的图片有时需要将工作表中的图形对象保存为单独的图像文件，可以使用Export方法将工作表中的图片以文件形式导出，如下面的代码所示。#001 Sub ExportShp()#002 Dim Shp As Shape#003 Dim FileName As St

15、ring#005 If Shp.Type = msoPicture Then#006 FileName = ThisWorkbook.Path & & Shp.Name & .gif#008 With Sheet1.ChartObjects.Add(0, 0, Shp.Width + 28, Shp.Height + 30).Chart#009 .Paste#010 .Export FileName, gif#012 End With#013 End If#014 Next#015 End Sub代码解析：ExportShp过程将Sheet1工作表的所有图片以文件形式导出到同一目录中。第4行代

16、码使用For Each.Next 语句遍历Sheet1工作表中的所有图形。第5行代码判断图形的类型是否为图片，应用于Shape对象的Type属性返回或设置图形类型，可以为表格 541所示的MsoShapeType常量之一。常量值说明msoShapeTypeMixed-2混合型图形msoAutoShape1自选图形msoCallout2没有边框线的标注msoChart3图表msoment4批注msoFreeform5任意多边形msoGroup6图形组合msoFormControl8窗体控件msoLine9线条msoLinkedOLEObject10式或内嵌OLE对象msoLinkedPictur

17、e11剪贴画或图片msoOLEControlObject12ActiveX 控件msoPicture13图片msoTextEffect15艺术字msoTextBox17文本框msoDiagram21组织结构图或其他图示表格 541MsoShapeType常量第6行代码使用字符串变量FileName记录需导出图形的路径和名称。第7行代码复制图形，应用于Shape对象的Copy方法将对象复制到剪贴板。第8行代码使用Add方法在工作表中添加一个图表，应用于ChartObjects对象的Add 方法创建新的嵌入图表，语法如下：expression.Add(Left, Top, Width, Heigh

18、t)参数expression是必需的，返回一个ChartObjects对象。参数Left、参数Top是必需的，以磅为单位给出新对象的初始坐标，该坐标是相对于工作表上单元格A1的左上角或图表的左上角的坐标。参数Width、参数Height是必需的，以磅为单位给出新对象的初始大小。第9行代码使用Paste方法将图形粘贴到新的嵌入图表中，应用于Chart对象的Paste方法将剪贴板中的图表数据粘贴到指定的图表中，语法如下：expression.Paste(Type)参数expression是必需的，返回一个Chart对象。参数Type是可选的的，如果剪贴板中有图表，本参数指定要粘贴的图表信息。可为以

19、下XlPasteType常量之一：xlFormats、xlFormulas或xlAll。默认值为xlAll，如果剪贴板中是数据不是图表，如此不能使用本参数。第10行代码使用Export方法将图表导出到同一目录中，应用于Chart对象的Export方法以图形格式导出图表，语法如下：expression.Export(Filename, FilterName, Interactive)其中参数Filename是必需的，被导出的文件的名称。第10行代码删除新建的图表。因为Chart对象是不能使用Delete方法直接删除的，应先使用Parent属性返回指定对象的父对象，然后使用Delete方法删除。技

20、巧2 在工作表中添加艺术字在工作表中插入艺术字，可以使用AddTextEffect方法，如下面的代码所示。#001 Sub TextEffect()#002 Dim myShape As Shape#003 On Error Resume Next#004 Sheet1.Shapes(myShape).Delete#005 Set myShape = Sheet1.Shapes.AddTextEffect _#006 (PresetTextEffect:=msoTextEffect15, _#007 Text:=我爱 Excel Home, FontName:=宋体, FontSize:=36

21、, _#008 FontBold:=msoFalse, FontItalic:=msoFalse, _#009 Left:=100, Top:=100)#010 With myShape#011 .Name = myShape#012 With .Fill#013 .Solid#014 .ForeColor.SchemeColor = 55#015 .Transparency = 0#016 End With#017 With .Line#019 .DashStyle = msoLineSolid#020 .Style = msoLineSingle#021 .Transparency = 0

22、#022 .ForeColor.SchemeColor = 12#023 .BackColor.RGB = RGB(255, 255, 255)#024 End With#025 End With#026 Set myShape = Nothing#027 End Sub代码解析：TextEffect过程在工作表中插入艺术字并设置其格式。第3、4行代码删除工作表中可能存在的艺术字，以免重复添加。第5行到第9行代码使用AddTextEffect方法在工作表中插入艺术字，AddTextEffect方法创建艺术字对象。返回一个Shape对象，该对象代表新建的艺术字对象，语法如下：expression

23、.AddTextEffect(PresetTextEffect, Text, FontName, FontSize, FontBold, FontItalic, Left, Top)参数expression是必需的，返回一个Shapes对象。参数PresetTextEffect是必需的，艺术字预置文本效果，可为MsoPresetTextEffect 常量之一，等同于在工作表中插入艺术字时的样式选项卡，如图 551所示。图 551艺术字样式参数Text是必需的，艺术字对象中的文字。参数FontName是必需的，艺术字对象中所用的字体名称。参数FontSize是必需的，以磅为单位给出艺术字对象中所

24、用的字体大小。参数FontBold是必需的，在艺术字中要加粗的字体。参数FontItalic是必需的，在艺术字中要倾斜的字体。参数Left和参数Top是必需的，相对于文档的左上角、顶部，以磅为单位给出艺术字对象边框左上角的位置。第11行代码将艺术字对象重命名为“myShape。第12行到第16行代码设置艺术字对象的填充格式。其中第13行代码将填充格式设置为均一的颜色，应用于FillFormat 对象的Solid方法将指定的填充格式设置为均一的颜色，可用本方法将带有渐进色、纹理、图案或背景的填充格式转换为单色的填充格式。第14行代码设置填充的颜色。第15行代码设置填充的透明度。第17行到第24行

25、代码设置艺术字对象的线条格式属性。其中第18行代码设置线条粗细，第19行代码设置线条虚线样式，第20行代码设置线条区域的样式，第21行代码设置线条的透明度，第22行代码设置前景色，第23行代码设置填充背景的颜色。运行TextEffect过程工作表中如图 552所示。图 552工作表中插入艺术字技巧3 遍历工作表中的图形工作表中的多个图形，如果使用系统缺省名称，如“文本框1、“文本框2这样前面是固定的字符串，后面是序号的，可以使用For.Next 语句遍历图形，如下面的代码所示。#001 Sub ErgShapes_1()#002 Dim i As Integer#003 For i = 1 T

26、o 4#004 Sheet1.Shapes(文本框 & i).TextFrame.Characters.Text = #005 Next#006 End Sub代码解析：ErgShapes_1过程去除工作表中四个图形文本框中的文字。第3行到第5行代码，使用Shapes属性在工作表上的三个图形文本框中循环。Shapes属性返回Shapes对象，代表工作表或图形工作表上的所有图形，可以使用Shapesindex返回单个的Shape对象，其中index是图形的名称或索引号。返回单个的Shape对象后使用TextFrame 属性和Characters方法去除文本框中的字符，关于Shape对象的Text

27、Frame 属性和Characters方法请参阅技巧53 。如果图形的名称没有规律，可以使用For Each.Next 语句循环遍历所有图形，根据Type属性返回的图形类型进展相应的操作，如下面的代码所示。#001 Sub ErgShapes_2()#002 Dim myShape As Shape#003 Dim i As Integer#004 i = 1#006 If myShape.Type = msoTextBox Then#007 myShape.TextFrame.Characters.Text = 这是第 & i & 个文本框#008 i = i + 1#009 End If#

28、010 Next#011 End Sub代码解析：ErgShapes_2过程在工作表中的所有图形文本框中写入文本。第5行代码使用For Each.Next 语句循环遍历工作表中所有的图形对象。第6行到第9行代码如果图形对象是文本框如此在文本框中写入文本。其中第6行代码根据Type属性判断图形对象是否为文本框，应用于Shape对象的Type属性返回或设置图形类型，MsoShapeType类型，请参阅表格 541 。第7行代码根据返回的Type属性值在所有的文本框内写入相应的文本，如图 561所示。图 561遍历所有的文本框技巧4 移动、旋转图片工作表中的图片可以移动、旋转，如下面的代码所示。#0

29、01 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#007 .Left = Cos(i * (3.1416 / 180) * 100 + 100#008 .Fill.ForeColor.RGB = i * 100#009 For j = 1 To 10#010 .IncrementRotation -2#011 DoEvents#012

30、Next#013 Next#014 End With#015 End Sub代码解析：MoveShape过程移动、旋转工作表中的图片并不断改变其填充的前景色。第6行代码设置图片的Top属性值，应用于Shape对象的Top属性设置图形的顶端到工作表顶端的距离。在循环的过程中使用Sin函数将Top属性值设置为一个圆形的弧度值。Sin函数返回指定参数的正弦值，语法如下：Sin(number)参数number表示一个以弧度为单位的角。Sin函数取一角度为参数值，并返回角的对边长度除以斜边长度的比值，将角度除以180后即能角度转换为弧度。第7行代码设置图片的Left属性值，应用于Shape对象的Left属性设置图形从左边界至 A 列左边界在工作表中或图表区左边界在图表工作表中的距离。在循环的过程中使用Cos函数将Left属性值设置为一个圆形的弧度值。Cos函数返回指定一个角的余弦值，语法如下：Cos(number)参数number表示一个以弧度为单位的角。Cos函数的number参数为一个角，并返回直角三角形两边的比值