VBA常用技巧代码解析

ljyjpl · 发表于 2009-3-4 09:45

经典，感谢奉献!!!

没牙兔兔 · 发表于 2009-3-4 10:16

感谢
如此精华贴
可以整理出书了，一定支持

yuanzhuping · 发表于 2009-3-4 11:39

技巧57 移动、旋转图片
工作表中的图片可以移动、旋转，如下面的代码所示。

#001 Sub MoveShape()
#002 Dim i As Long
#003 Dim j As Long
#004 With Sheet1.Shapes(1)
#005 For i = 1 To 3000 Step 5
#006 .Top = Sin(i * (3.1416 / 180)) * 100 + 100
#007 .Left = Cos(i * (3.1416 / 180)) * 100 + 100
#008 .Fill.ForeColor.RGB = i * 100
#009 For j = 1 To 10
#010 .IncrementRotation -2
#011 DoEvents
#012 Next
#013 Next
#014 End With
#015 End Sub

复制代码

代码解析：
   MoveShape过程移动、旋转工作表中的图片并不断改变其填充的前景色。
   第6行代码设置图片的Top属性值，应用于Shape对象的Top属性设置图形的顶端到工作表顶端的距离。在循环的过程中使用Sin函数将Top属性值设置为一个圆形的弧度值。Sin函数返回指定参数的正弦值，语法如下：
Sin(number)
   参数number表示一个以弧度为单位的角。
   Sin函数取一角度为参数值，并返回角的对边长度除以斜边长度的比值，将角度除以180后即能角度转换为弧度。
   第7行代码设置图片的Left属性值，应用于Shape对象的Left属性设置图形从左边界至 A 列左边界（在工作表中）或图表区左边界（在图表工作表中）的距离。在循环的过程中使用Cos函数将Left属性值设置为一个圆形的弧度值。Cos函数返回指定一个角的余弦值，语法如下：
Cos(number)
   参数number表示一个以弧度为单位的角。
   Cos函数的number参数为一个角，并返回直角三角形两边的比值，该比值为角的邻边长度除以斜边长度之商，将角度除以180后即能角度转换为弧度。
   第8行代码设置图片填充的前景色随着循环的过程不断的变化。使用Fill属性返回一个FillFormat对象，FillFormat对象代表图形的填充格式，其ForeColor 属性设置对象填充的前景色。
   第9行到第11行代码在图形移动的过程中使用IncrementRotation方法设置图形绕 z 轴的转角，IncrementRotation方法以指定的度数为增量，更改指定的图形绕 z 轴的转角，语法如下：
expression.IncrementRotation(Increment)
   参数expression是必需的，返回一个Shape对象。
   参数Increment是必需的，以度为单位指定图形在水平方向的旋转量，正值使图形按顺时针方向旋转，负值使图形按逆时针方向旋转。
   其中第11行是关键的代码，使用DoEvents函数转让控制权，否则达不到预计的视觉效果。
   运行MoveShape过程，工作表的图形在自身进行逆时针方向旋转的同时沿着一个圆形的弧度进行移动，并不断改变其填充的颜色。

铭英 · 发表于 2009-3-4 18:39

收藏起来！谢谢楼主！

yuanzhuping · 发表于 2009-3-4 21:13

技巧58 工作表中自动插入图片
在日常工作中经常需要在工作表中插入大量图片，比如在如图所示的工作表中需要根据A列的名称在C列插入保存在同一目录中的相应的图片，如果使用手工插入不仅非常繁琐且极易出错，而使用VBA代码可以很好的完成操作。

示例代码如下：

#001 Sub insertPic()
#002 Dim i As Integer
#003 Dim FilPath As String
#004 Dim rng As Range
#005 Dim s As String
#006 With Sheet1
#007 For i = 3 To .Range("a65536").End(xlUp).Row
#008 FilPath = ThisWorkbook.Path & "" & .Cells(i, 1).Text & ".jpg"
#009 If Dir(FilPath) <> "" Then
#010 .Pictures.Insert(FilPath).Select
#011 Set rng = .Cells(i, 3)
#012 With Selection
#013 .Top = rng.Top + 1
#014 .Left = rng.Left + 1
#015 .Width = rng.Width - 1
#016 .Height = rng.Height - 1
#017 End With
#018 Else
#019 s = s & Chr(10) & .Cells(i, 1).Text
#020 End If
#021 Next
#022 .Cells(3, 1).Select
#023 End With
#024 If s <> "" Then
#025 MsgBox s & Chr(10) & "没有照片!"
#026 End If
#027 End Sub

复制代码

代码解析：
   insertPic过程使用Insert方法在工作表中插入图片。
   第7行代码开始For...Next循环，循环的终值由工作表中A列单元格的行数所决定。
   第8行代码字符串变量FilPath保存A列名称单元格所对应的图片文件的路径和文件名，本例中图片文件的文件名应和A列中的名称一致。
   第9行到第11行代码使用Dir函数在同一文件夹中查找与A列单元格中的名称相对应的图片文件，如果对应的图片文件存在则使用Insert方法将图片插入到工作表中，并将C列的单元格赋给变量rng。
   Dir函数返回一个String，用以表示一个文件名、目录名或文件夹名称，它必须与指定的模式或文件属性、或磁盘卷标相匹配。如果已没有合乎条件的文件，则Dir函数会返回一个零长度字符串 ("")。
   第12行到第17行代码，当图片片插入到工作表时其实是插入到活动单元格的，此时需设置图片的Top属性和Left属性将图片移动到C列所对应的单元格中，并设置其Width属性和Height属性使其适应所在单元格的大小。
   第18、19行代码如果在同一文件夹中没有与A列单元格对应的图片文件，则使用字符串变量s保存没有图片文件的名称。
   第24行到第26行代码如果字符串变量s不等于空白说明文件夹中缺少图片文件，使用消息框提示。
   运行insertPic过程工作表如图所示。

如果文件夹中缺少对应的图片文件，则会进行提示，如图所示。

铭英 · 发表于 2009-3-4 21:27

yuanzhuping · 发表于 2009-3-5 09:45

技巧59 固定工作表中图形的位置
工作表中插入的图片，一般都是固定的尺寸和固定的单元格区域中的，但在实际使用中可能因一些人为的因素导致图片位置偏移或尺寸变化，此时可以使用VBA代码进行调整，如下面的代码所示。

#001 Sub ShapeAddress()
#002 Dim rng As Range
#003 Set rng = Sheet1.Range("B4:E22")
#004 With Sheet1.Shapes("Picture 1")
#005 .Rotation = 0
#006 .Select
#007 With Selection
#008 .Top = rng(1).Top + 1
#009 .Left = rng(1).Left + 1
#010 .Width = rng.Width - 0.5
#011 .Height = rng.Height - 0.5
#012 End With
#013 End With
#014 Range("A1").Select
#015 End Sub

复制代码

代码解析：
   ShapeAddress过程调整指定图形在工作表中的位置。
   第3行代码变量rng保存工作表中插入图片的单元格区域。。
   第5行代码设置图片的转角，应用于Shape对象Rotation属性以度为单位返回或设置图形的转角，设置为正值向右偏转，设置为负值向左偏转，设置为零图片则保持90度垂直。
   第7行到第12行代码设置图片的Top属性和Left属性将图片移动变量rng所保存的单元格区域中，并设置其Width属性和Height属性使其适应所在单元格区域的大小。
   第14行代码选择A1单元格，不然图片处于选中状态。
   经过以上设置，工作表中的图片“Picture 1”不管处于什么状态都可以一键恢复其原来的大小、位置。

qiujwen · 发表于 2009-3-5 12:51

大作呀，学习中。。。

cani228 · 发表于 2009-3-5 13:03

请问33楼中 Not Rng Is Nothing 和Loop While Not Rng Is Nothing 这是什么意思呢，不是特别明白，以后能否解析的详细些，毕竟有些是新手，谢谢

guoanxiang · 发表于 2009-3-5 15:01

原帖由 yuanzhuping 于 2009-2-12 17:56 发表
技巧17       双击被保护单元格时不显示提示消息框
   当用户使用鼠标左键双击被保护工作表中锁定的单元格区域时，系统将显示如图所示的消息框。
460592
   如果不希望显示该消息框，可以在工作表Works ...

如果你选择单元格，然后按delete键的话还是会出现保护的按钮！望解答～

		自动登录	找回密码
密码			免费注册

VBA常用技巧代码解析

第4部分 Shape（图形）、Chart（图表）对象

评分

第4部分 Shape（图形）、Chart（图表）对象

评分

评分

第4部分 Shape（图形）、Chart（图表）对象