VBA常用技巧代码解析

sex_huangzewen

这实在是我等刚入门的福气，有这么好的版主，我基本一上网就进EH，来补充自己的知识

yuanzhuping

技巧63         多图表制作
       如果需要，我们可以为工作表中的每一个数据区域创建一张图表，在如图所示的工作表区域中，需要为每一个员工的全年数据创建一张图表。

       示例代码如下：

1. #001  Sub ChartsAdd()
   
2. #002      Dim myChart As ChartObject
   
3. #003      Dim i As Integer
   
4. #004      Dim R As Integer
   
5. #005      Dim m As Integer
   
6. #006      R = Sheet1.Range("A65536").End(xlUp).Row - 1
   
7. #007      m = Abs(Int(-(R / 4)))
   
8. #008      Sheet2.ChartObjects.Delete
   
9. #009      For i = 1 To R
   
10. #010          Set myChart = Sheet2.ChartObjects.Add _
    
11. #011              (Left:=(((i - 1) Mod m) + 1) * 350 - 320, _
    
12. #012              Top:=((i - 1) \ m + 1) * 220 - 210, _
    
13. #013              Width:=330, Height:=210)
    
14. #014          With myChart.Chart
    
15. #015              .ChartType = xlColumnClustered
    
16. #016              .SetSourceData Source:=Sheet1.Range("B2:M2").Offset(i - 1), _
    
17. #017              PlotBy:=xlRows
    
18. #018              With .SeriesCollection(1)
    
19. #019                  .XValues = Sheet1.Range("B1:M1")
    
20. #020                  .Name = Sheet1.Range("A2").Offset(i - 1)
    
21. #021                  .ApplyDataLabels AutoText:=True, ShowValue:=True
    
22. #022                  .DataLabels.Font.Size = 10
    
23. #023              End With
    
24. #024              .HasLegend = False
    
25. #025              With .ChartTitle
    
26. #026                  .Left = 5
    
27. #027                  .Top = 1
    
28. #028                  .Font.Size = 14
    
29. #029                  .Font.Name = "华文行楷"
    
30. #030              End With
    
31. #031              With .PlotArea.Interior
    
32. #032                  .ColorIndex = 2
    
33. #033                  .PatternColorIndex = 1
    
34. #034                  .Pattern = xlSolid
    
35. #035              End With
    
36. #036              .Axes(xlCategory).TickLabels.Font.Size = 10
    
37. #037              .Axes(xlValue).TickLabels.Font.Size = 10
    
38. #038          End With
    
39. #039      Next
    
40. #040      Sheet2.Select
    
41. #041      Set myChart = Nothing
    
42. #042  End Sub

复制代码

代码解析：
       ChartsAdd过程根据数据工作表A列的人数在图表工作表中创建图表并分4行排列整齐。
       第6行代码取得数据工作表中需要创建图表的人数。
       第7行代码计算图表工作表每行需要排列的图表数目，共分4行排列。使用Int函数返回图表数目除4行后的整数部分，使用负值是为了向上取整数，最后使用Abs函数返回绝对值，将负值转化为正值。
       第8行代码使用Delete方法删除图表工作表中存在的所有图表。
       第9行代码开始For...Next循环，循环的终值由需要创建的图表数目决定。
       第10行到第13行代码使用Add方法在图表工作表中创建嵌入的图表，关于应用于ChartObjects对象的Add方法请参阅技巧60 。其中第11、12行代码根据循环计数器的数值设置新创建图表的Left和Top属性使之依次排列。第13行代码设置图表的大小。
       第15行代码设置新创建图表的类型。
       第16、17行代码根据循环计数器的数值分别设置新创建图表的数据源。
       第18行到第23行代码设置图表第一个数据系列的名称、数据标签和字体格式。
       第24行代码删除图表中的图例。
       第25行到第30行代码设置图表的标题。
       第31行到第35行代码设置图表的绘图区。
       第36、37行代码设置图表坐标轴的字体大小。
       关于图表的设置请参阅技巧60 。
       运行ChartsAdd过程图表工作表中如图所示。

liusongs

有这么好的版主，谢谢!!!!!!!!!!!!!!!!!!
我一上网就进EH，来补充自己的知识,来学习学习!!!!!!!!!

slyvie

真的是很好的贴子哦,我每天都来学习的,在这里严重感谢一下楼主的辛苦劳动!

yuanzhuping

1-4部分Word文档
VBA常用技巧(1-4).part1.rar (1.72 MB, 下载次数: 6565)

2009-3-10 11:13 上传

点击文件名下载附件

VBA常用技巧(1-4).part2.rar (605.68 KB, 下载次数: 4406)

2009-3-10 11:13 上传

点击文件名下载附件

第4部分附件
第4章 Shape（图形）、Chart（图表）对象.rar (1.68 MB, 下载次数: 9875)

2009-3-10 11:13 上传

点击文件名下载附件

yuanzhuping

技巧64         取得Microsoft Excel版本信息
       Application对象的Version属性可以返回Microsoft Excel的版本号，如下面的代码所示。

1. #001  Sub AppVersion()
   
2. #002      Dim myVersion As String
   
3. #003      Select Case Application.Version
   
4. #004          Case "8.0"
   
5. #005              myVersion = "97"
   
6. #006          Case "9.0"
   
7. #007              myVersion = "2000"
   
8. #008          Case "10.0"
   
9. #009              myVersion = "2002"
   
10. #010          Case "11.0"
    
11. #011              myVersion = "2003"
    
12. #012          Case Else
    
13. #013              myVersion = "版本未知"
    
14. #014      End Select
    
15. #015      MsgBox "Excel 版本是： " & myVersion
    
16. #016  End Sub

复制代码

代码解析：
       AppVersion过程返回Application对象的Version属性值来取得Microsoft Excel版本号。
       应用于Application对象的Version属性返回Microsoft Excel版本号，语法如下：
expression.Version
       参数expression是必需的，Application对象。
       运行AppVersion过程结果如图所示。

yuanzhuping

技巧65         取得当前用户名称
       使用Application对象的UserName属性可以取得当前用户名称，如下面的代码所示。

1. Sub UserName()
   
2.     MsgBox "当前用户名是: " & Application.UserName
   
3. End Sub

复制代码

代码解析：
       UserName过程使用消息框显示当前用户名称。
       Application对象的UserName属性返回或设置当前用户的名称。
       运行UserName过程效果如图所示。

yuanzhuping

技巧66         Excel中的“定时器”
       Excel VBA并没有提供定时器控件，但是用户可以通过Application对象的OnTime方法实现简单的定时器功能，如下面的代码所示。

1. #001  Sub StartTimer()
   
2. #002      Sheet1.Cells(1, 2) = Sheet1.Cells(1, 2) + 1
   
3. #003      Application.OnTime Now + TimeValue("00:00:01"), "StartTimer"
   
4. #004  End Sub

复制代码

代码解析：
       StartTimer过程，使用Application对象的OnTime方法循环调用StartTimer过程实现每隔一秒钟运行一次StartTimer过程，从而在B1单元格中不断地显示程序累计运行时间，如图所示。

       第2行代码将B1单元格的值在原有的数字上加1。
      第3行代码使用OnTime方法在1秒后重新调用StartTimer过程，使B1单元格的值不断的加1，从而显示程序累计运行时间。
      应用于Application对象的OnTime方法能够安排一个过程在将来的特定时间运行，语法如下：
expression.OnTime(EarliestTime, Procedure, LatestTime, Schedule)
       参数expression是必需的，返回一个Application对象。
       参数EarliestTime是必需的，设置指定的过程开始运行的时间。使用Now + TimeValue(time)可以安排从现在开始经过一段时间之后运行某个过程，使用TimeValue(time)可以安排在指定的时间运行某个过程。
       参数Procedure是必需的，设置要运行的过程名称。
       参数LatestTime是可选的，设置过程开始运行的最晚时间。例如将参数LatestTime设置为EarliestTime+10，当时间到了EarliestTime时如果Excel不处于空闲状态，那么Excel将等待10秒，如果在10秒内Excel不能回到空闲状态，则不运行该过程。如果省略该参数，Excel将一直等待到可以运行该过程为止。
       参数Schedule是可选的，如果其值为True（默认值），则安排一个新的OnTime过程，如果其值为False，则清除先前设置的过程。
       取消定时的代码如下：

1. #001  Sub EndTimer()
   
2. #002      On Error GoTo Line
   
3. #003      Application.OnTime Now + TimeValue("00:00:01"), "StartTimer", , False
   
4. #004      Sheet1.Cells(1, 2) = 0
   
5. #005      Exit Sub
   
6. #006  Line:
   
7. #007      MsgBox "请先按[开始]按钮!"
   
8. #008  End Sub

复制代码

代码解析：
       EndTimer过程取消StartTimer过程的定时。
       第2行代码错误处理语句，因为如果还没有运行StartTimer过程而先运行EndTimer过程取消定时，程序会提示错误，如图 所示，因此使用On Error GoTo Line语句在错误发生时执行第7行代码显示一个如图 所示的提示消息框。

关于此示例中定时时间大于一秒的运行错误已由cxmgxl 解决，示例在597楼，http://club.excelhome.net/thread-395683-60-1.html，在此表示感谢。

[ 本帖最后由 yuanzhuping 于 2009-3-28 23:33 编辑 ]

yuanzhuping

技巧67         设置活动打印机的名称
       使用Application 对象的ActivePrinter属性可以设置活动打印机的名称，如下面的代码所示。

1. #001  Sub myPrinter()
   
2. #002      Dim myPrinter As String
   
3. #003      myPrinter = "HP LaserJet P1008 在 Ne04:"
   
4. #004      Application.ActivePrinter = myPrinter
   
5. #005      MsgBox "活动打印机为：" & Left(myPrinter, InStr(myPrinter, "在") - 1)
   
6. #006  End Sub

复制代码

代码解析：
       myPrinter过程将活动打印机设置为“HP LaserJet P1008”。
       第3行代码指定需要设置为活动打印机的名称，第4行代码通过设置Application 对象的ActivePrinter属性将活动打印机设置为“HP LaserJet P1008”。
       第5行代码使用消息框显示活动打印机的名称及型号。
       运行myPrinter过程结果如图所示。

darkknight

自动插入图片的情况下，让该图片在此单元格中自动居中代码应该如何写？请求指点，我尝试定义一个新的shapes变量，但是不知道如何让对应的图片赋值。
下面是微软提供的一个方案，但是提示找不到slide
Sub ImportPictureAtSize()

   Dim oSlide As Slide
   Dim oPicture As Shape

   ' Change slide index position to the first slide
   ActiveWindow.View.GotoSlide 1

   ' Set oSlide to the first slide in the presentation.
   Set oSlide = ActiveWindow.Presentation.Slides(1)

   ' Set oPicture to the picture file on your computer. Set Link To
   ' File to false, Save With Document to true, and place it in the
   ' upper left-hand corner of the slide, sized to 1 by 1 points.
   '
   ' NOTE: Before you run this code replace this text string:
   '   "Put image path here!"
   ' with the path to the image you want to import. For example:
   '   "c:\MyImage.bmp"
   Set oPicture = oSlide.Shapes.AddPicture("Put image path here!", _
      msoFalse, msoTrue, 1, 1, 1, 1)
   ' Now scale the picture to full size, with "Relative to original
   ' picture size" set to true for both height and width.
   oPicture.ScaleHeight 1, msoTrue
   oPicture.ScaleWidth 1, msoTrue

   ' Move the picture to the center of the slide. Select it.
   With ActivePresentation.PageSetup
      oPicture.Left = (.SlideWidth \ 2) - (oPicture.Width \ 2)
      oPicture.Top = (.SlideHeight \ 2) - (oPicture.Height \ 2)
      oPicture.Select
   End With

End Sub