ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: yuanzhuping

VBA常用技巧代码解析

    [复制链接]

TA的精华主题

TA的得分主题

发表于 2009-3-10 01:47 | 显示全部楼层
本帖已被收录到知识树中,索引项:开发帮助和教程
这实在是我等刚入门的福气,有这么好的版主,我基本一上网就进EH,来补充自己的知识

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-3-10 08:56 | 显示全部楼层

第4部分 Shape(图形)、Chart(图表)对象

技巧63         多图表制作
       如果需要,我们可以为工作表中的每一个数据区域创建一张图表,在如图所示的工作表区域中,需要为每一个员工的全年数据创建一张图表。
Snap2.jpg
       示例代码如下:
  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过程图表工作表中如图所示。
Snap4.jpg

技巧63 多图表制作.rar

14.82 KB, 下载次数: 1817

TA的精华主题

TA的得分主题

发表于 2009-3-10 09:52 | 显示全部楼层
有这么好的版主,谢谢!!!!!!!!!!!!!!!!!!
我一上网就进EH,来补充自己的知识,来学习学习!!!!!!!!!

TA的精华主题

TA的得分主题

发表于 2009-3-10 11:04 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
真的是很好的贴子哦,我每天都来学习的,在这里严重感谢一下楼主的辛苦劳动!

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-3-10 11:13 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

第4部分 Shape(图形)、Chart(图表)对象

1-4部分Word文档
VBA常用技巧(1-4).part1.rar (1.72 MB, 下载次数: 6563)
VBA常用技巧(1-4).part2.rar (605.68 KB, 下载次数: 4404)
第4部分附件
第4章 Shape(图形)、Chart(图表)对象.rar (1.68 MB, 下载次数: 9873)

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-3-10 11:46 | 显示全部楼层

第5部分 Application对象

技巧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过程结果如图所示。
Snap1.jpg

技巧64 取得Microsoft Excel版本信息.rar

5.97 KB, 下载次数: 1333

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-3-10 11:56 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

第5部分 Application对象

技巧65         取得当前用户名称
       使用Application对象的UserName属性可以取得当前用户名称,如下面的代码所示。
  1. Sub UserName()
  2.     MsgBox "当前用户名是: " & Application.UserName
  3. End Sub
复制代码
代码解析:
       UserName过程使用消息框显示当前用户名称。
       Application对象的UserName属性返回或设置当前用户的名称。
       运行UserName过程效果如图所示。
Snap2.jpg

技巧65 取得当前用户名称.rar

5.34 KB, 下载次数: 1324

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-3-10 15:44 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

第5部分 Application对象

技巧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单元格中不断地显示程序累计运行时间,如图所示。
Snap3.jpg
       第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过程取消定时,程序会提示错误,如图 Snap1.jpg 所示,因此使用On Error GoTo Line语句在错误发生时执行第7行代码显示一个如图 Snap2.jpg 所示的提示消息框。

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

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

技巧66 Excel中的“定时器”.rar

6.79 KB, 下载次数: 1537

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-3-10 16:22 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

第5部分 Application对象

技巧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过程结果如图所示。
Snap4.jpg

技巧67 设置活动打印机的名称.rar

6.06 KB, 下载次数: 1132

TA的精华主题

TA的得分主题

发表于 2009-3-10 17:29 | 显示全部楼层

回复 313楼 yuanzhuping 的帖子

自动插入图片的情况下,让该图片在此单元格中自动居中代码应该如何写?请求指点,我尝试定义一个新的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
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-14 15:03 , Processed in 0.053028 second(s), 6 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表