[转帖]图形对象介绍

xowi99 · 发表于 2008-9-10 09:42

图形对象攻略指引－qee用

经常有朋友抱怨图形对象不好用，太少的参考代码，摆脱不掉的Selection、看不见成员列表，繁琐的代码输入、组合……，本文将围饶图形对象的使用一一给出这些问题的解决策略。

一、概述
1．什么是图形对象？
本文所述图形对象包括图片和形状，是指从EXCEL菜单-视图-工具栏中“窗体”和“绘图”工具栏向工作表中添加的对象。它们具有OLE控件相似的外观和功能，但使用方法上差别很大。
2．为什么要使用图形对象
至少基于如下两点理由，笔者推荐在工作表上应尽量使用图形对象来代替标准控件：
（1）图形对象是Office的内置对象，占用的内存和磁盘空间都远远小于ActiveX控件，但它的功能却几乎能满足我常用的全部需求。
（2）图形对象的外观更生动活泼，当光标移动到图形对象上时便会出现一个小巧的手，这和我们见贯了的标准控件的严肃木纳相比，恰如炎夏的清凉，让我们感到亲切和喜悦。

二、添加图形对象
通常情况下，我们并不需要使用代码向工作表添加图形对象。根据图形对象的不同，添加的方法也不相同。
1．添加控件（“窗体”图形对象）
句法：object.Add(Left, Top, Width, Height)
object是工作表的下列成员之一：
Labels 标签
GroupBoxes 分组框
Buttons 按钮
CheckBoxes 复选框
OptionButtons 选项按钮
ListBoxes 列表框
DropDowns 组合框
ScrollBars 滚动条
Spinners 微调项
Left, Top, Width, Height分别指定新对象的初始坐标和初始大小（以磅为单位，下同）。
下面语句在工作表Sheet1上添加一个组合框：
Sheet1.DropDowns.Add 220.5, 147, 72, 22
2．添加直线（键头）
句法：object.AddLine(BeginX, BeginY, EndX, EndY)
object是工作表的Shapes 对象
BeginX, BeginY, EndX, EndY是直线的起点、终点位置。
下面语句在工作表Sheet1上添加一条直线：
Sheet1.Shapes.AddLine 100, 100, 180, 150
3．添加矩形、椭圆（圆）、自选图形
句法：object.AddShape(Type, Left, Top, Width, Height)
object是工作表的Shapes 对象
Type为MsoAutoShapeType 常量，指定要创建的自选图形的类型：
msoShapeRectangle（1）矩形
msoShapeOval（9）椭圆
未列出部分请参考对象浏览器中MsoAutoShapeType的描述。下同。
下面语句在工作表Sheet1上添加一个椭圆：
Sheet1.Shapes. AddShape msoShapeOval , 100, 100, 180, 150
4．添加文本框
句法：object.AddTextbox(Orientation, Left, Top, Width, Height)
object是工作表的Shapes 对象
Orientation为MsoTextOrientation常量，文本框内文字的方向：
msoTextOrientationHorizontal（1）横向
msoTextOrientationVerticalFarEast（4）纵向
下面语句在工作表Sheet1上添加一个横向文本框：
Sheet1.Shapes. AddTextbox msoTextOrientationHorizontal , 100, 100, 180, 150
5．添加艺术字
object.AddTextEffect(PresetTextEffect, Text, FontName, FontSize,FontBold, FontItalic, Left, Top) 句法：object是工作表的Shapes 对象
PresetTextEffect为MsoTextOrientation常量，预置的文字效果。可为msoTextEffect1至msoTextEffect30
Text艺术字对象中的文字。
FontName, FontSize,FontBold, FontItalic设置字体名称、大小、加粗和倾斜。
Left, Top给出艺术字对象所占矩形的左上角位置。
下面语句在工作表Sheet1上添加一个艺术字对象：
Sheet1.Shapes.AddTextEffect msoTextEffect27, "内容", "宋体", 36#, False, False, 82.5, 105
6．添加图片
句法：Sheetobject.Pictures.Insert picturefile
Sheetobject是要插入图片的工作表。
Picturefile是文件全路径。
下面语句在工作表Sheet1上添加一个图片：
Sheet1.Pictures.Insert “c:\My Document\Myfile.bmp”

三、使用图形对象
1．使用名称
对图形对象的引用通常有两种方式：
方式一：工作表名称.Shapes(“图形对象名称”)
方式二：工作表名称.[图形对象名称]
在插入图形对象时，默认的名称通常为“图片 1”、“列表框 3”、“直线 6”之类的格式，使用起来很不方便，我们可以把它修改成自己的名称。步骤：
（1）选定图形对象
（2）在名称框中输入新名称，回车

如果使用代码插入图形对象，可以在插入时命名，如：
Sheet1.DropDowns.Add( 220.5, 147, 72, 22).Name=”DRP1”
注：在系统内部还有一个看不见的名称，格式如“Line 1”（英文对象类别后加空格及数字序号），这个名称可以按照上面的方式引用，但不随Name设置的改变而改变。类似有趣的现象后面还会出现，本文不去探讨EXCEL的内部机制，有兴趣的朋友可以自己去做各种美妙的遐想。
虽然都指向同一个对象，这两种引用方式是有差别的，来看一段录制宏的代码：
Sub Macro1()

ActiveSheet.Shapes("LBX1").Select
    With Selection
        .Placement = xlMove
        .PrintObject = False
    End With
End Sub

上面的代码可以正确运行。
“录制宏，但要简化它”，是使用VBA的基本技巧，但简化成下面的代码是不能运行的，系统会提示“运行时错误（438）对象不支持属性或方法”：
Sub Macro1()
    With ActiveSheet.Shapes("LBX1")
        .Placement = xlMove
        .PrintObject = False
    End With
End Sub
如果将上面改为方式一的引用，用ActiveSheet.[LBX1]来代替ActiveSheet.Shapes("LBX1")，则可以正确运行。
正是基于这种差别，笔者建议在对图形对象的使用中使用第二种方式。
2．自动列出成员信息
使用名称解决了图形对象的运行障碍，但遗憾的是，却不能象使用标准控件时，当我们在VBE中输入对象的名称，再输入一个“点”后，VBE会自动列出它的成员方便地供我们选择。
事实上，图形对象一样可以做到。
让我们先来做一项预设置。打开对象留览器，在对象留览器中按鼠标右键，勾选“显示隐含成员”，然后关闭对象留览器。做好了上面设置，只需要根据为不同的图形对象引入一个明确类型的对变量，并将这个对象变量指向具体图形对象就可以了。下面是使用列表框的示意代码：
Dim lst As ListBox
Set lst = Sheet1.[LST1]
以后只要输入lst.后，就会自动列出列表框[LST1]的成员了。

注意：在不同的Office环境下，有些成员的使用受限制或不能使用。
图形对象的类名借助TypeName函数可以得到，下面给出常用的图形对象的类名。
Label  标签
GroupBoxe 分组框
Button  按钮
CheckBoxe 复选框
OptionButton 选项按钮
ListBoxe 列表框
DropDown 组合框
ScrollBar 滚动条
Spinner  微调项
Line  直线
Line  箭头
Rectangle 矩形
Oval  椭圆
TextBox  文本框
Rectangle 艺术字
Picture  图片，剪贴画
自选图形根据实际选定的图形确定
3．常用成员
虽然每个图形对象都有自己不同的成员，但有些成员在各图形对象中都会用到，象位置信息，有些在多个成员中用到，象Text属性。

Name 名称

OnAction 指定宏名

Visible Boollean型，是否可见

Left，Top 左上角位置

Width 宽度

Height 高度

TopLeftCell 左上角所在单元格

.BottomRightCell 右下角所在单元格

Locked 是否锁定

PrintObject 是否为打印对象

LinkedCell 控制单元格

Placement 位置方式，1-3，与设置自选图形格式“属性”选项卡对应

Text 文本内容

Value 值，列表框和组合框值为所选项在全部项中的索引号

[此贴子已经被作者于2008-9-12 14:24:19编辑过]

yaoxuejian · 发表于 2008-9-10 11:39

看看去·····················[em02]

xowi99 · 发表于 2008-9-12 14:22

四、代码实例
下面给出一些图形对象的代码实例。
[例1]标签
Sub aSmpLabel()
With Sheet1.[LAB1]
    .Caption = "标签文字"
    .Top = [d13].Top
    .Left = [d13].Left
    .Width = [d13].Width
    .Height = [d13].Height
    .PrintObject = False
    .Locked = False
    .LockedText = False
    .Placement = 1
    .ShapeRange.LockAspectRatio = True
    .OnAction = ""
    MsgBox .Name & "所在单元格区域为" & .TopLeftCell.Address & ":" & .BottomRightCell.Address
End With
End Sub
[例2]按钮
Sub aSmpCommandButton()
With Sheet1.[CMB1]
    .Caption = "Hello"
    .Top = [d13].Top
    .Left = [d13].Left
    .Width = [d13].Width
    .Height = [d13].Height
    .PrintObject = False
    .Locked = False
    .LockedText = False
    .Placement = 1
    .ShapeRange.LockAspectRatio = True
     With .Characters(Start:=3, Length:=2).Font
        .Name = "宋体"
        .FontStyle = "常规"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 3
      End With
    With .ShapeRange.TextFrame
      .MarginLeft = 0
      .MarginRight = 0
      .MarginTop = 0
      .MarginBottom = 0
    End With
    .OnAction = ""
    MsgBox .Name & "所在单元格区域为" & .TopLeftCell.Address & ":" & .BottomRightCell.Address
End With
End Sub
[例3]复选框
Sub aSmpCheckbox()
With Sheet1.[CHK1]
    .Caption = "Hello"
    .Top = [d13].Top
    .Left = [d13].Left
    .Width = [d13].Width
    .Height = [d13].Height
    .Value = xlOff
    .LinkedCell = "$D3"
    .Display3DShading = True
    .PrintObject = False
    .Locked = False
    .LockedText = False
    .Placement = 1
    .ShapeRange.LockAspectRatio = True
    .OnAction = ""
     MsgBox .Name & "所在单元格区域为" & .TopLeftCell.Address & ":" & .BottomRightCell.Address
End With
End Sub
[例4]列表框
Sub aSmpListbox()
With Sheet1.[LST1]
    .Top = 100
    .Left = 100
    .Height = 100
    .Width = 100
    .LinkedCell = "B20"
    .ListFillRange = "B21:B22"
    .MultiSelect = xlNone
    .Value = 2
    .OnAction = ""
    MsgBox "总选项" & .ListCount & "当前选项" & .List(.Value)
End With
End Sub
[例5]组合框
Sub aSmpCombox()
With Sheet1.[COMB1]
    .Top = 100
    .Left = 100
    .Height = 20
    .Width = 100
    .LinkedCell = "B20"
    .RemoveAllItems
    .AddItem "A"
    .AddItem "B"
    .Value = 2
    .OnAction = ""
    MsgBox "总选项" & .ListCount & "当前选项" & .List(.Value)
End With
End Sub
[例6]滚动条
Sub aSmpScrollbarr()
With Sheet1.[SCRB1]
    .Min = 1
    .Max = 100
    .SmallChange = 1
    .LargeChange = 100
    .LinkedCell = "d1"
    .OnAction = ""
End With
End Sub
[例7]微调框
Sub aSmpSpinner()
With Sheet1.[spn1]
    .Min = 1
    .Max = 100
    .SmallChange = 1
    .Locked = True
    .PrintObject = False
    .LinkedCell = "d1"
    .OnAction = ""
End With
End Sub
[例8]直线/键头
Sub aSmpLine()
Sheet1.Shapes.AddLine(100, 100, 180, 150).Name = "Line1"
With [line1].ShapeRange.Line
    .Weight = 3
    .DashStyle = msoLineSolid
    .Style = msoLineThinThin
    .Visible = True
    .ForeColor.SchemeColor = 10
    .BackColor.RGB = RGB(255, 255, 255)
    .EndArrowheadStyle = msoArrowheadTriangle
    .EndArrowheadLength = msoArrowheadLengthMedium
    .EndArrowheadWidth = msoArrowheadWidthMedium
End With
MsgBox "Will deleted!"
[line1].Delete
End Sub
[例9]矩形
Sub aSmpRect()
Sheet1.Shapes.AddShape(msoShapeRectangle, 100, 100, 100, 40).Name = "Rect1"
With [rect1]
    .Text = "Hello"
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .AutoSize = False
    With .ShapeRange.Fill
      .Solid
      .ForeColor.SchemeColor = 47
      .Visible = True
    End With
    .ShapeRange.Shadow.Type = msoShadow17
    .Characters(Start:=1, Length:=2).Font.ColorIndex = 3
End With
MsgBox "Will deleted!"
[rect1].Delete
End Sub
[例10]椭圆
Sub aSmpRound()
Sheet1.Shapes.AddShape(msoShapeOval, 100, 100, 100, 60).Name = "Round1"
With [round1]
    .Text = "Hello"
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .AutoSize = False
    With .ShapeRange.Fill
      .Solid
      .ForeColor.SchemeColor = 60
      .Visible = True
    End With
    .ShapeRange.Shadow.Type = msoShadow17
    .Characters(Start:=1, Length:=2).Font.ColorIndex = 3
End With
MsgBox "Will deleted!"
[round1].Delete
End Sub
[例11]文本框
Sub aSmpTxt()
Sheet1.Shapes.AddShape(msoTextOrientationHorizontal, 100, 100, 100, 60).Name = "TxT1"
With [TxT1]
    .Text = "Hello"
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .AutoSize = False
    With .ShapeRange.Fill
      .Solid
      .ForeColor.SchemeColor = 60
      .Visible = True
    End With
    .ShapeRange.Shadow.Type = msoShadow17
    .Characters(Start:=1, Length:=2).Font.ColorIndex = 3
End With
MsgBox "Will deleted!"
[TxT1].Delete
End Sub
[例12]图片
Sub aSmpPict()
Sheet1.Pictures.Insert("C:\Pict\pct1.bmp").Name = "Pct1"
MsgBox "Will CHange"
With Sheet1.[Pct1]
    .Left = 100
    .Top = 100
    .Width = 50
    .Height = 50
    With .ShapeRange.PictureFormat
      .Brightness = 0.6
      .Contrast = 0.3
    End With
    With .ShapeRange.Fill
      .Solid
      .ForeColor.SchemeColor = 10
      .Transparency = 0.3
    End With
    With .ShapeRange
      .LockAspectRatio = False
      .Rotation = 90#
    End With
End With
MsgBox "Will deleted!"
[Pct1].Delete
End Sub
[例13]删除矩形
Sub aSmpDelShapes()
Dim shp As Shape
For Each shp In Sheet1.Shapes
    shp.Select
    If TypeName(Selection) = "Rectangle" Then shp.Delete
Next shp
End Sub

不看不看 · 发表于 2008-9-12 14:25

好东东，支持一下！！！

不看不看 · 发表于 2008-9-12 14:28

用版的大作呀，以前怎么没有看到！！！

关于图形，偶以前都是录制宏后再摸索修改[em03]

slyrabbit · 发表于 2008-10-17 17:38

支持

		自动登录	找回密码
密码			注册