[已解决]关于VBA80集第44集：vba图片与图形处理的问题？？？

pluto720

Sub 图片导入()
'删除已有图片
Dim S As Shape
Dim RG As Range
For Each S In ActiveSheet.Shapes
   If S.Type <> 8 Then
     S.Delete
   End If
Next S
'导入图片

  For Each RG In Range("b2:b5")
   ' Range("B2").Select
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, RG.Left, RG.Top, RG.Width, RG.Height).Select
    Selection.ShapeRange.Fill.UserPicture "E:\学习资料\兰色幻想VBA80集\VBA80集第44集：图片与图形处理\" & RG.Offset(0, -1) & ".jpg"
  Next RG
End Sub


1）为什么这个程序只可以运行一次。我运行第二次的时候就没有反映了.

2) 以上面的代码RG.Offset(0, -1)，不是应该在A1：A5上插入图片吗，可是为什么在B2：B5上插入图片？

请高手详解!!!我是初学者！！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-12-8 13:25

加个对话框你能看到效果。

跳转到最佳答案楼层

hwc2ycy

RG.Offset(0, -1) & ".jpg"这是文件名。

pluto720

hwc2ycy 发表于 2013-12-8 13:10
RG.Offset(0, -1) & ".jpg"这是文件名。

哦 知道了 谢谢！
可以解释一下第一个问题吗？？？

pluto720

pluto720 发表于 2013-12-8 13:19
哦 知道了 谢谢！
可以解释一下第一个问题吗？？？

运行第二次不是也应该先删除图片 在添加吗？可是为什么第二次就不删除了？谢谢！

pluto720

hwc2ycy 发表于 2013-12-8 13:10
RG.Offset(0, -1) & ".jpg"这是文件名。

运行第二次不是也应该先删除图片 在添加吗？可是为什么第二次就不删除了？谢谢！

hwc2ycy

1. Sub 图片导入()
   
2. '删除已有图片
   
3. Dim S As Shape
   
4. Dim RG As Range
   
5. For Each S In ActiveSheet.Shapes
   
6.    If S.Type <> 8 Then
   
7.      S.Delete
   
8.    End If
   
9. Next S
   
10. '导入图片
    
11.    
    
12.   For Each RG In Range("b2:b5")
    
13.    ' Range("B2").Select
    
14.     ActiveSheet.Shapes.AddShape(msoShapeRectangle, RG.Left, RG.Top, RG.Width, RG.Height).Select
    
15.     Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "" & RG.Offset(0, -1) & ".jpg"
    
16.   Next RG
    
17. End Sub

复制代码

我这重复执行多次也没有问题啊。

hwc2ycy

你F8吧，因为执行完后，也是插入四个图片，跟原来效果没区别的。

1. Sub 图片导入()
   
2. '删除已有图片
   
3.     Dim S As Shape
   
4.     Dim RG As Range
   
5.     For Each S In ActiveSheet.Shapes
   
6.         If S.Type <> 8 Then
   
7.             S.Delete
   
8.         End If
   
9.     Next S
   
10.     MsgBox "原有图片删除完成，确定 后继续插入图片"
    
11. 
    
12.     '导入图片
    
13. 
    
14.     For Each RG In Range("b2:b5")
    
15.         ' Range("B2").Select
    
16.         ActiveSheet.Shapes.AddShape(msoShapeRectangle, RG.Left, RG.Top, RG.Width, RG.Height).Select
    
17.         Selection.ShapeRange.Fill.UserPicture ThisWorkbook.Path & "" & RG.Offset(0, -1) & ".jpg"
    
18.     Next RG
    
19. End Sub

复制代码

hwc2ycy

加个对话框你能看到效果。

hwc2ycy

pluto720 发表于 2013-12-8 13:21
运行第二次不是也应该先删除图片 在添加吗？可是为什么第二次就不删除了？谢谢！

代码是先删除再添加，只不过是中间没停顿，一气呵成，所以你看不到效果嘛。