图形对象攻略指引

qee用

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

一、概述
1．什么是图形对象？
本文所述图形对象包括图片和形状，是指从EXCEL菜单-视图-工具栏中“窗体”和“绘图”工具栏向工作表中添加的对象。它们具有OLE控件相似的外观和功能，但使用方法上差别很大。
（图1）

2．为什么要使用图形对象
至少基于如下两点理由，笔者推荐在工作表上应尽量使用图形对象来代替标准控件：
（1）图形对象是Office的内置对象，占用的内存和磁盘空间都远远小于ActiveX控件，但它的功能却几乎能满足我常用的全部需求。
（2）图形对象的外观更生动活泼，当光标移动到图形对象上时便会出现一个小巧的手，这和我们见贯了的标准控件的严肃木纳相比，恰如炎夏的清凉，让我们感到亲切和喜悦。

qee用

二、添加图形对象
通常情况下，我们并不需要使用代码向工作表添加图形对象。根据图形对象的不同，添加的方法也不相同。
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”

qee用

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

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

'
    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会自动列出它的成员方便地供我们选择。
（图3）

事实上，图形对象一样可以做到。
让我们先来做一项预设置。打开对象留览器，在对象留览器中按鼠标右键，勾选“显示隐含成员”，然后关闭对象留览器。
（图4）

做好了上面设置，只需要根据为不同的图形对象引入一个明确类型的对变量，并将这个对象变量指向具体图形对象就可以了。下面是使用列表框的示意代码：
  Dim lst As ListBox
  Set lst = Sheet1.[LST1]
以后只要输入lst.后，就会自动列出列表框[LST1]的成员了。
（图5）

注意：在不同的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  值，列表框和组合框值为所选项在全部项中的索引号
4．组合图形对象

为了管理和分组的需要，有时需要对一些图形对象进行组合使用。可以使用ShapeRange对象的Group方法完成。这里需要说明的是，组合后会对部分成员的调用产生影响，因此，在对组合成员进行代码操作时，一般可以先拆散集合，设置完成后在重新组合。
下面代码完成向工作表添加一个分组框和两个选项按钮，先将它们组合，然后拆散组合设置个图形对象后再重新组合。如果屏蔽Ungroup句，代码运行将出错。
Sub aSmpOptGroup()
    With Sheet1
      .GroupBoxes.Add(100, 100, 120, 30).Name = "FRAM1"
      .OptionButtons.Add(105, 105, 50, 20).Name = "OPT1"
      .OptionButtons.Add(160, 105, 50, 20).Name = "OPT2"
      .Shapes.Range(Array("FRAM1", "Opt1", "Opt2")).Group.Name = "GRP1"
      [GRP1].Ungroup '拆散组合
      .[FRAM1].Caption = "Hello"
      .[OPT1].Caption = "H1"
      .[OPT1].OnAction = "Macro6"
      .[OPT2].Caption = "H2"
      .[OPT2].OnAction = "Macro7"
      .Shapes.Range("FRAM1").Regroup.Name = "GRP1"
    End With
End Sub

qee用

四、代码实例
下面给出一些图形对象的代码实例。
[例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

qee用

五、后记
匆匆整理完成，错误和遗漏之处，请朋友们多多指正。[em12]

-------------------------------------------------------------------------------------------------

问：“窗体控件”的“窗体”指什么？

答：MS EXCEL5.0对话框。工作表标签-右击-插入-MS EXCEL5.0对话框。
设计好对话框后，可以在立即窗口执行如下命令将它隐藏（其实它就是Sheet)
DialogSheets("Dialog1").visible=xlSheetVeryHidden
在需要时执行如下命令将它显示出来：
DialogSheets("Dialog1").visible=xlSheetVisible
需要调用时，可以使用如下命令调用：
DialogSheets("Dialog1").Show
调用完成后，在窗体的某个按钮中加入如下代码隐藏：
DialogSheets("Dialog1").Hide
对于简单的窗体，其实完全可以不使用VBA的UserForm，而使用MS EXCEL5.0对话框来完成，好处嘛，同前。


问：MS EXCEL5.0对话框上的按钮，控制选项卡上的“ 默认、取消、解除、帮助”有什么用？

答：它们分别对应按钮的4个属性DefaultButton、DismissButton、CancelButton、HelpButton。
如果设置DefaultButton(默认)为True，则当在窗体上按回车键时，会自动执行这个按钮的宏。
设置DismissButton（解除）或CancelButton（取消）为True，在执行了这个按钮的宏后，会自动执行窗体的Hide方法关闭窗体。二者的区别在于返回值不同。设置CancelButton为True或从窗体控制栏关闭窗体，下面语句返回False。
blCloseMode = DialogSheets("Dialog1").Show
正常关闭窗体的时候上面的blCloseMode值为True。
设置HelpButton（帮助）为True的话，如果设置了Application.Help的话，则在执行了这个按钮的宏后，会调用Application.Help指定的帮助。

[此贴子已经被作者于2007-7-14 13:35:06编辑过]

Herman99

谢谢qee用斑竹的教程!先收藏学习!

yxy博

刚才粗看过一遍,先收藏着,再细看,好东东要顶...

willin2000

谢谢qee用,收藏了.

布衣铁剑

图形对象是个好玩的东东。

yuanzhuping

多谢用兄的整理，收下慢慢学习。