VBA常用技巧代码解析

guo7799

原代码无任何保护作用，因为SelectionChange触发，就会解除工作表保护，思路有问题。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   On Error Resume Next
   If Sheet1.Protection = False Then Sheet1.Protect Password:="12345"
   If Target.Value <> "" Then Target.Locked = True
End Sub
可以在BeforeDoubleClick事件中加入确需修改过程，提示工作表保护密码输入，解除表保护，限定密码错误重新输入次数

yuanzhuping

原帖由 guo7799 于 2009-3-3 06:37 发表
原代码无任何保护作用，因为SelectionChange触发，就会解除工作表保护，思路有问题。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   On Error Resume Next
   If Sheet1.Protection = False  ...

我不知你有没有没测试过，不错，第二句代码是解除了工作表的保护，但此技巧是保护工作表中已录入数据的单元格，只要不是空白单元格，下面还有保护工作表的代码，怎么无任何保护作用了？

guo7799

抱歉，刚测试了，代码正确！

sheet1

谢谢版主,好东西得好好收藏和学习

yuanzhuping

技巧55         在工作表中添加艺术字
       在工作表中插入艺术字，可以使用AddTextEffect方法，如下面的代码所示。

1. #001  Sub TextEffect()
   
2. #002      Dim myShape As Shape
   
3. #003      On Error Resume Next
   
4. #004      Sheet1.Shapes("myShape").Delete
   
5. #005      Set myShape = Sheet1.Shapes.AddTextEffect _
   
6. #006              (PresetTextEffect:=msoTextEffect15, _
   
7. #007              Text:="我爱 Excel Home", FontName:="宋体", FontSize:=36, _
   
8. #008              FontBold:=msoFalse, FontItalic:=msoFalse, _
   
9. #009              Left:=100, Top:=100)
   
10. #010      With myShape
    
11. #011          .Name = "myShape"
    
12. #012          With .Fill
    
13. #013              .Solid
    
14. #014              .ForeColor.SchemeColor = 55
    
15. #015              .Transparency = 0
    
16. #016          End With
    
17. #017          With .Line
    
18. #018              .Weight = 1.5
    
19. #019              .DashStyle = msoLineSolid
    
20. #020              .Style = msoLineSingle
    
21. #021              .Transparency = 0
    
22. #022              .ForeColor.SchemeColor = 12
    
23. #023              .BackColor.RGB = RGB(255, 255, 255)
    
24. #024          End With
    
25. #025      End With
    
26. #026      Set myShape = Nothing
    
27. #027  End Sub

复制代码

代码解析：
       TextEffect过程在工作表中插入艺术字并设置其格式。
       第3、4行代码删除工作表中可能存在的艺术字，以免重复添加。
       第5行到第9行代码使用AddTextEffect方法在工作表中插入艺术字，AddTextEffect方法创建艺术字对象。返回一个Shape对象，该对象代表新建的艺术字对象，语法如下：
expression.AddTextEffect(PresetTextEffect, Text, FontName, FontSize, FontBold, FontItalic, Left, Top)
       参数expression是必需的，返回一个Shapes对象。
       参数PresetTextEffect是必需的，艺术字预置文本效果，可为MsoPresetTextEffect 常量之一，等同于在工作表中插入艺术字时的样式选项卡，如图所示。

       参数Text是必需的，艺术字对象中的文字。
       参数FontName是必需的，艺术字对象中所用的字体名称。
       参数FontSize是必需的，以磅为单位给出艺术字对象中所用的字体大小。
       参数FontBold是必需的，在艺术字中要加粗的字体。
       参数FontItalic是必需的，在艺术字中要倾斜的字体。
       参数Left和参数Top是必需的，相对于文档的左上角、顶部，以磅为单位给出艺术字对象边框左上角的位置。
       第11行代码将艺术字对象重命名为“myShape”。
       第12行到第16行代码设置艺术字对象的填充格式。其中第13行代码将填充格式设置为均一的颜色，应用于FillFormat 对象的Solid方法将指定的填充格式设置为均一的颜色，可用本方法将带有渐进色、纹理、图案或背景的填充格式转换为单色的填充格式。第14行代码设置填充的颜色。第15行代码设置填充的透明度。
       第17行到第24行代码设置艺术字对象的线条格式属性。其中第18行代码设置线条粗细，第19行代码设置线条虚线样式，第20行代码设置线条区域的样式，第21行代码设置线条的透明度，第22行代码设置前景色，第23行代码设置填充背景的颜色。
       运行TextEffect过程工作表中如图所示。

nicholas_he

多谢斑竹，持续支持中！！！！！

pjz1890

谢谢版主无私的奉献，收藏学习！

yuanzhuping

技巧56         遍历工作表中的图形
       工作表中的多个图形，如果使用系统缺省名称，如“文本框1”、“文本框2”这样前面是固定的字符串，后面是序号的，可以使用For...Next 语句遍历图形，如下面的代码所示。

1. #001  Sub ErgShapes_1()
   
2. #002      Dim i As Integer
   
3. #003      For i = 1 To 4
   
4. #004          Sheet1.Shapes("文本框 " & i).TextFrame.Characters.Text = ""
   
5. #005      Next
   
6. #006  End Sub

复制代码

代码解析：
       ErgShapes_1过程清除工作表中四个图形文本框中的文字。
       第3行到第5行代码，使用Shapes属性在工作表上的三个图形文本框中循环。
       Shapes属性返回Shapes对象，代表工作表或图形工作表上的所有图形，可以使用Shapes（index）返回单个的Shape对象，其中index是图形的名称或索引号。
       返回单个的Shape对象后使用TextFrame 属性和Characters方法清除文本框中的字符，关于Shape对象的TextFrame 属性和Characters方法请参阅技巧53 。
       如果图形的名称没有规律，可以使用For Each...Next 语句循环遍历所有图形，根据Type属性返回的图形类型进行相应的操作，如下面的代码所示。

1. #001  Sub ErgShapes_2()
   
2. #002      Dim myShape As Shape
   
3. #003      Dim i As Integer
   
4. #004      i = 1
   
5. #005      For Each myShape In Sheet1.Shapes
   
6. #006          If myShape.Type = msoTextBox Then
   
7. #007              myShape.TextFrame.Characters.Text = "这是第" & i & "个文本框"
   
8. #008              i = i + 1
   
9. #009          End If
   
10. #010      Next
    
11. #011  End Sub

复制代码

代码解析：
       ErgShapes_2过程在工作表中的所有图形文本框中写入文本。
       第5行代码使用For Each...Next 语句循环遍历工作表中所有的图形对象。
       第6行到第9行代码如果图形对象是文本框则在文本框中写入文本。其中第6行代码根据Type属性判断图形对象是否为文本框，应用于Shape对象的Type属性返回或设置图形类型，MsoShapeType类型，如表格所示。

       第7行代码根据返回的Type属性值在所有的文本框内写入相应的文本，如图所示。


[ 本帖最后由 yuanzhuping 于 2009-3-4 21:50 编辑 ]

一_一

版主辛苦,一直跟着您学习,
感激不尽,总算是入门了,前二个部分基本可以应用到实际中了

wangjfnm

谢谢版主的无私奉献！学习中