最新Excel-VBA常用技巧-第04章.shape(图形)、Chart(图表)对象.doc

《最新Excel-VBA常用技巧-第04章.shape(图形)、Chart(图表)对象.doc》由会员分享，可在线阅读，更多相关《最新Excel-VBA常用技巧-第04章.shape(图形)、Chart(图表)对象.doc（29页珍藏版）》请在淘文阁 - 分享文档赚钱的网站上搜索。

1、精品资料Excel-VBA常用技巧-第04章.shape(图形)、Chart(图表)对象.VBA常用技巧目录第4章 Shape（图形）、Chart（图表）对象技巧1 在工作表中添加图形如果需要在工作表中添加图形对象，可以使用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,

2、120, 280, 30)#006 With myShape#007 .Name = myShape#008 With .TextFrame.Characters#009 .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 = -

3、4108#020 End With#021 .Placement = 3#022 End With#023 myShape.Select#024 With Selection.ShapeRange#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, 2

4、55)#033 End With#034 With .Fill#035 .Transparency = 0#036 .Visible = msoTrue#037 .ForeColor.SchemeColor = 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!#

5、044 Set myShape = Nothing#045 End Sub代码解析：AddShape过程在工作表中添加一个矩形并设置其外观等属性。第2行代码声明变量myShape的对象类型。第3、4行代码删除可能存在的名称为“myShape”的图形对象。第5行代码使用AddShape方法在工作表中添加一个矩形。当该方法应用于Shapes对象时，返回一个Shape对象，该对象代表工作表中的新自选图形，语法如下：expression.AddShape(Type, Left, Top, Width, Height)参数expression是必需的，返回一个Shapes对象。参数Type是必需的，指定

6、要创建的自选图形的类型。参数Left和Top是必需的，以磅为单位给出自选图形边框左上角的位置。参数Width和Height是必需的，以磅为单位给出自选图形边框的宽度和高度。第7行代码将新建图形命名为“myShape”，向Shapes集合添加新的图形时，将对新添加的图形赋以默认的名称，若要为图形指定更有意义的名称，可指定其Name属性。第8行到第16行代码为矩形添加文字，并设定其格式。其中第8行代码使用TextFrame 属性和Characters方法返回该矩形的字符区域。应用于Shape对象的TextFrame 属性返回一个TextFrame对象，该对象包含指定图形对象的对齐和定位属性；Cha

7、racters方法返回一个Characters对象，该对象代表某个图形的文本框中的字符区域，语法如下：expression.Characters(Start, Length)参数expression是必需的，返回一个指定文本框内Characters对象的表达式。参数Start是可选的，表示将要返回的第一个字符，如果此参数设置为 1 或被忽略，则Characters方法会返回以第一个字符为起始字符的字符区域。参数Length是可选的，表示要返回的字符个数。如果此参数被忽略，则Characters方法会返回该字符串的剩余部分（由Start参数指定的字符以后的所有字符）。第9行代码为矩形添加文字，应

8、用于Characters对象的Text属性返回或设置对象的文本，为可读写的String类型。第10行到第15行代码设置矩形中文字的属性，应用于Characters对象Font属性返回一个Font对象，该对象代表指定对象的字体属性（字体名称、字体大小、字体颜色等），第11行代码设置字体名称，第12行代码设置字体样式，第13行代码设置字体大小，第14行代码颜色。第17行到第20行代码设定矩形中文字的对齐方式。应用于TextFrame对象的HorizontalAlignment属性返回或设置指定对象的水平对齐方式，可为表格 531所示的XlHAlign常量之一。常量值描述xlHAlignCenter

9、-4108居中xlHAlignCenterAcrossSelection7靠左xlHAlignDistributed-4117分散对齐xlHAlignFill5分散对齐xlHAlignGeneral1靠左xlHAlignJustify-4130两端对齐xlHAlignLeft-4131靠左xlHAlignRight-4152靠右表格 11HorizontalAlignment属性的XlHAlign常量应用于TextFrame对象的VerticalAlignment属性返回或设置指定对象的垂直对齐方式，可为表格 532所示的XlHAlign常量之一。常量值描述xlVAlignCenter-410

10、8居中xlVAlignJustify-4130两端对齐xlVAlignBottom-4107靠下xlVAlignDistributed-4117分散对齐xlVAlignTop-4160靠上表格 12VerticalAlignment属性的XlHAlign常量第21行代码设置矩形大小和位置不随单元格而变，应用于Shape对象的Placement属性返回或设置对象与所在的单元格之间的附属关系，可为表格 533所示的XlPlacement常量之一。常量值描述xlFreeFloating3大小、位置均固定xlMove2大小固定、位置随单元格而变xlMoveAndSize1大小、位置随单元格而变表格 1

11、3XlPlacement常量第24行到第32行代码设置矩形的边框线条格式，应用于ShapeRange集合的Line属性返回一个LineFormat 对象，该对象包含指定图形的线条格式属性。其中第26行代码设置矩形线条粗细，第27行代码设置矩形线条的虚线样式，第28行代码设置矩形填充的透明度，第29行代码设置矩形为可见，第30行代码设置矩形的前景色，第31行代码设置矩形填充背景的颜色。第33行到第38行代码设置矩形的内部填充格式，应用于ShapeRange集合的Fill属性返回FillFormat对象，该对象包含指定的图表或图形的填充格式属性。其中第35行代码设置矩形内部的透明度，第36行代码设

12、置矩形内部为可见，第37行代码设置矩形内部的前景色，第38行代码将矩形内部指定填充设为单色渐变，应用于 FillFormat对象的OneColorGradient方法将指定填充设为单色渐变，语法如下：expression.OneColorGradient(Style, Variant, Degree)其中参数Style是必需的，底纹样式，可为表格 541所示的MsoGradientStyle常量之一。常量值描述msoGradientDiagonalDown4斜下msoGradientDiagonalUp3斜上msoGradientFromCenter7无msoGradientFromCorne

13、r5角部幅射msoGradientFromTitle6中心幅射msoGradientHorizontal1水平msoGradientMixed-2无msoGradientVertical2垂直表格 14MsoGradientStyle常量参数Variant是必需的，渐变变量。取值范围为 1 到 4 之间，分别与“填充效果”对话框中“渐变”选项卡的四个渐变变量相对应。如果GradientStyle 设为 msoGradientFromCenter，则Variant参数只能设为 1 或 2。参数Degree是必需的，灰度。取值范围为 0.0（表示最深）到 1.0（表示最浅）之间。第42、43行代码

14、为矩形对象添加超链接，应用于Hyperlinks对象的Add方法向指定的区域或图形添加超链接，语法如下：expression.Add(Anchor, Address, SubAddress, ScreenTip, TextToDisplay)参数expression是必需的，返回一个Hyperlinks对象。参数Anchor是必需的，超链接的位置。可为Range对象或Shape对象。参数Address是必需的，超链接的地址。参数SubAddress是必需的，超链接的子地址。参数ScreenTip是可选的，当鼠标指针停留在超链接上时所显示的屏幕提示。参数TextToDisplay是可选的，要显示

15、的超链接的文本。运行AddShape过程结果如图 531所示。图 11在工作表中添加图形技巧2 导出工作表中的图片有时需要将工作表中的图形对象保存为单独的图像文件，可以使用Export方法将工作表中的图片以文件形式导出，如下面的代码所示。#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.Nam

16、e & .gif#007 Shp.Copy#008 With Sheet1.ChartObjects.Add(0, 0, Shp.Width + 28, Shp.Height + 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行代码判断图形的类型是否

17、为图片，应用于Shape对象的Type属性返回或设置图形类型，可以为表格 541所示的MsoShapeType常量之一。常量值说明msoShapeTypeMixed-2混合型图形msoAutoShape1自选图形msoCallout2没有边框线的标注msoChart3图表msoComment4批注msoFreeform5任意多边形msoGroup6图形组合msoFormControl8窗体控件msoLine9线条msoLinkedOLEObject10链接式或内嵌OLE对象msoLinkedPicture11剪贴画或图片msoOLEControlObject12ActiveX 控件msoPic

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

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

20、为xlAll，如果剪贴板中是数据不是图表，则不能使用本参数。第10行代码使用Export方法将图表导出到同一目录中，应用于Chart对象的Export方法以图形格式导出图表，语法如下：expression.Export(Filename, FilterName, Interactive)其中参数Filename是必需的，被导出的文件的名称。第10行代码删除新建的图表。因为Chart对象是不能使用Delete方法直接删除的，应先使用Parent属性返回指定对象的父对象，然后使用Delete方法删除。技巧3 在工作表中添加艺术字在工作表中插入艺术字，可以使用AddTextEffect方法，如下面的

21、代码所示。#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, _#008 FontBold:=msoFalse, FontItalic:=msoFalse

22、, _#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#018 .Weight = 1.5#019 .DashStyle = msoLineSolid#020 .Style = msoLineSingle#021 .Transparency = 0#022 .ForeColor.SchemeColor =

23、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.AddTextEffect(PresetTextEffec

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

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

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

27、).TextFrame.Characters.Text = #005 Next#006 End Sub代码解析：ErgShapes_1过程清除工作表中四个图形文本框中的文字。第3行到第5行代码，使用Shapes属性在工作表上的三个图形文本框中循环。Shapes属性返回Shapes对象，代表工作表或图形工作表上的所有图形，可以使用Shapes（index）返回单个的Shape对象，其中index是图形的名称或索引号。返回单个的Shape对象后使用TextFrame 属性和Characters方法清除文本框中的字符，关于Shape对象的TextFrame 属性和Characters方法请参阅技巧1

28、 。如果图形的名称没有规律，可以使用For Each.Next 语句循环遍历所有图形，根据Type属性返回的图形类型进行相应的操作，如下面的代码所示。#001 Sub 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#0

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

30、代码所示。#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#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 DoEven

31、ts#012 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

32、对象的Left属性设置图形从左边界至 A 列左边界（在工作表中）或图表区左边界（在图表工作表中）的距离。在循环的过程中使用Cos函数将Left属性值设置为一个圆形的弧度值。Cos函数返回指定一个角的余弦值，语法如下：Cos(number)参数number表示一个以弧度为单位的角。Cos函数的number参数为一个角，并返回直角三角形两边的比值，该比值为角的邻边长度除以斜边长度之商，将角度除以180后即能角度转换为弧度。第8行代码设置图片填充的前景色随着循环的过程不断的变化。使用Fill属性返回一个FillFormat对象，FillFormat对象代表图形的填充格式，其ForeColor 属性设

33、置对象填充的前景色。第9行到第11行代码在图形移动的过程中使用IncrementRotation方法设置图形绕 z 轴的转角，IncrementRotation方法以指定的度数为增量，更改指定的图形绕 z 轴的转角，语法如下：expression.IncrementRotation(Increment)参数expression是必需的，返回一个Shape对象。参数Increment是必需的，以度为单位指定图形在水平方向的旋转量，正值使图形按顺时针方向旋转，负值使图形按逆时针方向旋转。其中第11行是关键的代码，使用DoEvents函数转让控制权，否则达不到预计的视觉效果。运行MoveShape过

34、程，工作表的图形在自身进行逆时针方向旋转的同时沿着一个圆形的弧度进行移动，并不断改变其填充的颜色。技巧6 工作表中自动插入图片在日常工作中经常需要在工作表中插入大量图片，比如在如图 581所示的工作表中需要根据A列的名称在C列插入保存在同一目录中的相应的图片，如果使用手工插入不仅非常繁琐且极易出错，而使用VBA代码可以很好的完成操作。图 61需插入图片的工作表示例代码如下：#001 Sub insertPic()#002 Dim i As Integer#003 Dim FilPath As String#004 Dim rng As Range#005 Dim s As String#006

35、 With Sheet1#007 For i = 3 To .Range(a65536).End(xlUp).Row#008 FilPath = ThisWorkbook.Path & & .Cells(i, 1).Text & .jpg#009 If Dir(FilPath) Then#010 .Pictures.Insert(FilPath).Select#011 Set rng = .Cells(i, 3)#012 With Selection#013 .Top = rng.Top + 1#014 .Left = rng.Left + 1#015 .Width = rng.Width -

36、 1#016 .Height = rng.Height - 1#017 End With#018 Else#019 s = s & Chr(10) & .Cells(i, 1).Text#020 End If#021 Next#022 .Cells(3, 1).Select#023 End With#024 If s Then#025 MsgBox s & Chr(10) & 没有照片!#026 End If#027 End Sub代码解析：insertPic过程使用Insert方法在工作表中插入图片。第7行代码开始For.Next循环，循环的终值由工作表中A列单元格的行数所决定。第8行代码字

37、符串变量FilPath保存A列名称单元格所对应的图片文件的路径和文件名，本例中图片文件的文件名应和A列中的名称一致。第9行到第11行代码使用Dir函数在同一文件夹中查找与A列单元格中的名称相对应的图片文件，如果对应的图片文件存在则使用Insert方法将图片插入到工作表中，并将C列的单元格赋给变量rng。Dir函数返回一个String，用以表示一个文件名、目录名或文件夹名称，它必须与指定的模式或文件属性、或磁盘卷标相匹配。如果已没有合乎条件的文件，则Dir函数会返回一个零长度字符串 ()。第12行到第17行代码，当图片片插入到工作表时其实是插入到活动单元格的，此时需设置图片的Top属性和Left

38、属性将图片移动到C列所对应的单元格中，并设置其Width属性和Height属性使其适应所在单元格的大小。第18、19行代码如果在同一文件夹中没有与A列单元格对应的图片文件，则使用字符串变量s保存没有图片文件的名称。第24行到第26行代码如果字符串变量s不等于空白说明文件夹中缺少图片文件，使用消息框提示。运行insertPic过程工作表如图 582所示。图 62插入图片后的工作表如果文件夹中缺少对应的图片文件，则会进行提示，如图 583所示。图 63缺少图片文件提示技巧7 固定工作表中图形的位置工作表中插入的图片，一般都是固定的尺寸和固定的单元格区域中的，但在实际使用中可能因一些人为的因素导致图

39、片位置偏移或尺寸变化，此时可以使用VBA代码进行调整，如下面的代码所示。#001 Sub ShapeAddress()#002 Dim rng As Range#003 Set rng = Sheet1.Range(B4:E22)#004 With Sheet1.Shapes(Picture 1)#005 .Rotation = 0#006 .Select#007 With Selection#008 .Top = rng(1).Top + 1#009 .Left = rng(1).Left + 1#010 .Width = rng.Width - 0.5#011 .Height = rng.

40、Height - 0.5#012 End With#013 End With#014 Range(A1).Select#015 End Sub代码解析：ShapeAddress过程调整指定图形在工作表中的位置。第3行代码变量rng保存工作表中插入图片的单元格区域。第5行代码设置图片的转角，应用于Shape对象Rotation属性以度为单位返回或设置图形的转角，设置为正值向右偏转，设置为负值向左偏转，设置为零图片则保持90度垂直。第7行到第12行代码设置图片的Top属性和Left属性将图片移动到变量rng所保存的单元格区域中，并设置其Width属性和Height属性使其适应所在单元格区域的大小。

41、第14行代码选择A1单元格，不然图片会处于选中状态。经过以上设置，工作表中的图片“Picture 1”不管处于什么状态都可以一键恢复其原来的大小、位置。技巧8 使用VBA自动生成图表在实际工作中我们常用图表来表现数据间的某种相对关系，一般采用手工插入的方式，而使用VBA代码可以在工作表中自动生成图表，如下面的示例代码。#001 Sub ChartAdd()#002 Dim myRange As Range#003 Dim myChart As ChartObject#004 Dim R As Integer#005 With Sheet1#006 .ChartObjects.Delete#007 R = .Range(A65536).End(xlUp).Row#008 Set myRange =