第4章Shape(图形)、Chart(图表)对象代码[超实用VBA]

3 2 第 4 章 Shape（ 图 形 ） 、Chart（ 图 表） 对象 范例47 在工作表中添加图形 Sub AddingGraphics() Dim MyShape As Shape On Error Resume Next Sheet1.Shapes("MyShape").Delete Set MyShape = Sheet1.Shapes.AddShape(msoShapeRectangle, 40, 120, 280, 30) With MyShape .Name = "MyShape" With .TextFrame.Characters .Text = "单击将选择 Sheet2!" With .Font .Size = 20 .ColorIndex = 5 End With End With With .Line .Weight = 1 .Style = msoLineSingle .Transparency = 0.5 .ForeColor.SchemeColor = 40 .BackColor.RGB = RGB(255, 255, 255) End With With .Fill .Transparency = 0.5 .ForeColor.SchemeColor = 41 .OneColorGradient 1, 4, 0.23 End With .Placement = 3 End With Sheet1.Hyperlinks.Add Anchor:=MyShape, Address:="", _ SubAddress:="Sheet2!A1", ScreenTip:="选择 Sheet2!" Set MyShape = Nothing End Sub 3 3 范例4 8 导出工作表中的图片 Sub ExportPictures() Dim MyShp As Shape Dim Filename As String For Each MyShp In Sheet1.Shapes If MyShp.Type = msoPicture Then Filename = ThisWorkbook.Path & "\" & MyShp.Name & ".gif" MyShp.Copy With Sheet1.ChartObjects.Add(0, 0, MyShp.Width, MyShp.Height).Chart .Paste .Export Filename .Parent.Delete End With End If Next Set MyShp = Nothing End Sub 范例4 9 在工作表中添加艺术字 Sub AddingWordArt() On Error Resume Next Sheet1.Shapes("MyShape").Delete Sheet1.Shapes.AddTextEffect _ (PresetTextEffect:=msoTextEffect16, _ Text:="Excel 2007", FontName:="宋体", _ FontSize:=50, FontBold:=True, _ FontItalic:=True, Left:=60, Top:=60).Name = "MyShape" End Sub 范例5 0 遍历工作表中的形状 Sub TraversalShapeOne() Dim i As Integer For i = 1 To 4 Sheet1.Shapes("文本框 " & i).TextFrame.Characters.Text = "" Next End Sub Sub TraversalShapeTwo() 3 4 Dim MyShape As Shape Dim MyCount As Integer MyCount = 1 For Each MyShape In Sheet1.Shapes If MyShape.Typ...