第4章__Shape(图形)Chart(图表)对象代码【超实用VBA】.docVIP

第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 范例48 导出工作表中的图片 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 范例49 在工作表中添加艺术字 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 范例50 遍历工作表中的形状Sub TraversalShapeOne() Dim i As Integer For i = 1 To 4 Sheet1.Shapes(文本框 i).TextFrame.Characters.Text = Next End Sub Sub TraversalShapeTwo()