VBA常用技巧代码解析

din8881234

mk1320

技巧19  如果你選中幾個單元各就會出錯， 有什麽辦法解決呢？

yuanzhuping

原帖由 mk1320 于 2009-3-1 23:01 发表
技巧19  如果你選中幾個單元各就會出錯， 有什麽辦法解決呢？

我疏忽了，加个错误处理语句。

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     On Error Resume Next
   
3.     Sheet1.Unprotect Password:="12345"
   
4.     If Target.Value <> "" Then
   
5.         Target.Locked = True
   
6.         Sheet1.Protect Password:="12345"
   
7.     End If
   
8. End Sub

复制代码

yuanzhuping

技巧53         在工作表中添加图形
       如果需要在工作表中添加图形对象，可以使用AddShape方法，如下面的代码所示。

1. #001  Sub AddShape()
   
2. #002      Dim myShape As Shape
   
3. #003      On Error Resume Next
   
4. #004      Sheet1.Shapes("myShape").Delete
   
5. #005      Set myShape = Sheet1.Shapes.AddShape(msoShapeRectangle, 40, 120, 280, 30)
   
6. #006      With myShape
   
7. #007          .Name = "myShape"
   
8. #008          With .TextFrame.Characters
   
9. #009              .Text = "单击将选择Sheet2!"
   
10. #010              With .Font
    
11. #011                  .Name = "华文行楷"
    
12. #012                  .FontStyle = "常规"
    
13. #013                  .Size = 22
    
14. #014                  .ColorIndex = 7
    
15. #015              End With
    
16. #016          End With
    
17. #017          With .TextFrame   
    
18. #018              .HorizontalAlignment = -4108
    
19. #019              .VerticalAlignment = -4108
    
20. #020          End With
    
21. #021          .Placement = 3
    
22. #022      End With
    
23. #023      myShape.Select
    
24. #024      With Selection.ShapeRange
    
25. #025          With .Line
    
26. #026              .Weight = 1
    
27. #027              .DashStyle = msoLineSolid
    
28. #028              .Style = msoLineSingle
    
29. #029              .Transparency = 0
    
30. #030              .Visible = msoTrue
    
31. #031              .ForeColor.SchemeColor = 40
    
32. #032              .BackColor.RGB = RGB(255, 255, 255)
    
33. #033          End With
    
34. #034          With .Fill
    
35. #035              .Transparency = 0
    
36. #036              .Visible = msoTrue
    
37. #037              .ForeColor.SchemeColor = 41
    
38. #038              .OneColorGradient 1, 4, 0.23
    
39. #039          End With
    
40. #040      End With
    
41. #041      Sheet1.Range("A1").Select
    
42. #042      Sheet1.Hyperlinks.Add Anchor:=myShape, Address:="", _
    
43. #043          SubAddress:="Sheet2!A1", ScreenTip:="选择Sheet2!"
    
44. #044      Set myShape = Nothing
    
45. #045  End Sub

复制代码

代码解析：
       AddShape过程在工作表中添加一个矩形并设置其外观等属性。
       第2行代码声明变量myShape的对象类型。
       第3、4行代码删除可以存在的名称为“myShape”的图形对象。
       第5行代码使用AddShape方法在工作表中添加一个矩形。当该方法应用于Shapes对象时，返回一个Shape对象，该对象代表工作表中的新自选图形，语法如下：
expression.AddShape(Type, Left, Top, Width, Height)
       参数expression是必需的，返回一个Shapes对象。
       参数Type是必需的，指定要创建的自选图形的类型。
       参数Left和Top是必需的，以磅为单位给出自选图形边框左上角的位置。
       参数Width和Height是必需的，以磅为单位给出自选图形边框的宽度和高度。
       第7行代码将新建图形命名为“myShape”，向Shapes集合添加新的图形时，将对新添加的图形赋以默认的名称，若要为图形指定更有意义的名称，可指定其Name属性。
       第8行到第16行代码为矩形添加文字，并设定其格式。
       其中第8行代码使用TextFrame 属性和Characters方法返回该矩形的字符区域。应用于Shape对象的TextFrame 属性返回一个TextFrame对象，该对象包含指定图形对象的对齐和定位属性；Characters方法返回一个Characters对象，该对象代表某个图形的文本框中的字符区域，语法如下：
expression.Characters(Start, Length)
       参数expression是必需的，返回一个指定文本框内Characters对象的表达式。
       参数Start是可选的，表示将要返回的第一个字符，如果此参数设置为 1 或被忽略，则Characters方法会返回以第一个字符为起始字符的字符区域。
       参数Length是可选的，表示要返回的字符个数。如果此参数被忽略，则Characters方法会返回该字符串的剩余部分（由Start参数指定的字符以后的所有字符）。
       第9行代码为矩形添加文字，应用于Characters对象的Text属性返回或设置对象的文本，为可读写的String类型。
       第10行到第15行代码设置矩形中文字的属性，应用于Characters对象Font属性返回一个Font对象，该对象代表指定对象的字体属性（字体名称、字体大小、字体颜色等），第11行代码设置字体名称，第12行代码设置字体样式，第13行代码设置字体大小，第14行代码颜色。
       第17行到第20行代码设定矩形中文字的对齐方式。应用于TextFrame对象的HorizontalAlignment属性返回或设置指定对象的水平对齐方式，可为表格所示的XlHAlign常量之一。

       应用于TextFrame对象的VerticalAlignment属性返回或设置指定对象的垂直对齐方式，可为表格所示的XlHAlign常量之一。

       第21行代码设置矩形大小和位置不随单元格而变，应用于Shape对象的Placement属性返回或设置对象与所在的单元格之间的附属关系，可为表格所示的XlPlacement常量之一。

       第24行到第32行代码设置矩形的边框线条格式，应用于ShapeRange集合的Line属性返回一个LineFormat 对象，该对象包含指定图形的线条格式属性。
       其中第26行代码设置矩形线条粗细，第27行代码设置矩形线条的虚线样式，第28行代码设置矩形填充的透明度，第29行代码设置矩形为可见，第30行代码设置矩形的前景色，第31行代码设置矩形填充背景的颜色。
       第33行到第38行代码设置矩形的内部填充格式，应用于ShapeRange集合的Fill属性返回FillFormat对象，该对象包含指定的图表或图形的填充格式属性。
       其中第35行代码设置矩形内部的透明度，第36行代码设置矩形内部为可见，第37行代码设置矩形内部的前景色，第38行代码将矩形内部指定填充设为单色渐变，应用于 FillFormat对象的OneColorGradient方法将指定填充设为单色渐变，语法如下：
expression.OneColorGradient(Style, Variant, Degree)
       其中参数Style是必需的，底纹样式，可为表格所示的MsoGradientStyle常量之一。

       参数Variant是必需的，渐变变量。取值范围为 1 到 4 之间，分别与“填充效果”对话框中“渐变”选项卡的四个渐变变量相对应。如果GradientStyle 设为 msoGradientFromCenter，则Variant参数只能设为 1 或 2。
       参数Degree是必需的，灰度。取值范围为 0.0（表示最深）到 1.0（表示最浅）之间。
       第42、43行代码为矩形对象添加超链接，应用于Hyperlinks对象的Add方法向指定的区域或图形添加超链接，语法如下：
expression.Add(Anchor, Address, SubAddress, ScreenTip, TextToDisplay)
       参数expression是必需的，返回一个Hyperlinks对象。
       参数Anchor是必需的，超链接的位置。可为Range对象或Shape对象。
       参数Address是必需的，超链接的地址。
       参数SubAddress是必需的，超链接的子地址。
       参数ScreenTip是可选的，当鼠标指针停留在超链接上时所显示的屏幕提示。
       参数TextToDisplay是可选的，要显示的超链接的文本。
       运行AddShape过程结果如图所示。


[ 本帖最后由 yuanzhuping 于 2009-3-3 14:17 编辑 ]

shain2004

下了好多资料！！哥们，太感谢你了！！那么好的东西。。。。你真是太好了！！！！向你学习呀！！！！！

口是心非

坚决支持袁版，正是我们所需求的，继续关注中！

不是高手

很好很好简直太好了，
学习学习
谢谢
顶

lin07

真的很感谢~~~~~~~~~~~~~~~

yuanzhuping

技巧54         导出工作表中的图片
       使用Export方法将工作表中的图片以文件形式导出，如下面的代码所示。

1. #001  Sub ExportShp()
   
2. #002      Dim Shp As Shape
   
3. #003      Dim FileName As String
   
4. #004      For Each Shp In Sheet1.Shapes
   
5. #005          If Shp.Type = msoPicture Then
   
6. #006              FileName = ThisWorkbook.Path & "" & Shp.Name & ".gif"
   
7. #007              Shp.Copy
   
8. #008              With Sheet1.ChartObjects.Add(0, 0, Shp.Width + 28, Shp.Height + 30).Chart
   
9. #009                  .Paste
   
10. #010                  .Export FileName, "gif"
    
11. #011                  .Parent.Delete
    
12. #012              End With
    
13. #013          End If
    
14. #014      Next
    
15. #015  End Sub

复制代码

代码解析：
       ExportShp过程将Sheet1工作表的所有图片以文件形式导出到同一目录中。
       第4行代码使用For Each...Next 语句遍历Sheet1工作表中的所有图形。
       第5行代码判断图形的类型是否为图片，应用于Shape对象的Type属性返回或设置图形类型，可以为表格所示的MsoShapeType常量之一。

       第6行代码使用字符串变量FileName记录需导出图形的路径和名称。
       第7行代码复制图形，应用于Shape对象的Copy方法将对象复制到剪贴板。
       第8行代码使用Add方法在工作表中添加一个图表，应用于ChartObjects对象的Add 方法创建新的嵌入图表，语法如下：
expression.Add(Left, Top, Width, Height)
       参数expression是必需的，返回一个ChartObjects对象。
       参数Left、参数Top是必需的，以磅为单位给出新对象的初始坐标，该坐标是相对于工作表上单元格A1的左上角或图表的左上角的坐标。
       参数Width、参数Height是必需的，以磅为单位给出新对象的初始大小。
       第9行代码使用Paste方法将图形粘贴到新的嵌入图表中，应用于Chart对象的Paste方法将剪贴板中的图表数据粘贴到指定的图表中，语法如下：
expression.Paste(Type)
       参数expression是必需的，返回一个Chart对象。
       参数Type是可选的的，如果剪贴板中有图表，本参数指定要粘贴的图表信息。可为以下XlPasteType常量之一：xlFormats、xlFormulas或xlAll。默认值为xlAll，如果剪贴板中是数据不是图表，则不能使用本参数。
       第10行代码使用Export方法将图表导出到同一目录中，应用于Chart对象的Export方法以图形格式导出图表，语法如下：
expression.Export(Filename, FilterName, Interactive)
       其中参数Filename是必需的，被导出的文件的名称。
       第10行代码删除新建的图表。因为Chart对象是不能使用Delete方法直接删除的，应先使用Parent属性返回指定对象的父对象，然后使用Delete方法删除。

[ 本帖最后由 yuanzhuping 于 2009-3-3 14:17 编辑 ]

a10101101

UPUPUPUPUPUPUPUP