工作表中多行多列插入图片

晓山青

在多行多列中自动插入图片.rar (332.35 KB, 下载次数: 144)

2013-2-26 12:56 上传

点击文件名下载附件
在多行多列中自动插入图片

通过在论坛学习，基本上学会了在行或者列的方向自动插入图片的方法，但是如果在同一张工作表内同时在多行多列中自动插入图片，怎么解决呢？请各位老师不吝赐教，非常感谢。

蓝桥玄霜

1. Sub cartup()
   
2.     Dim rng As Range, ML, MT, MW, MH, shp As Shape, Myc%, Myr&, i&, j&
   
3.     On Error Resume Next
   
4.     Sheet1.Activate
   
5.     For Each shp In ActiveSheet.Shapes
   
6.         If shp.Type = msoAutoShape Then
   
7.             shp.Delete
   
8.         End If
   
9.     Next
   
10.     Myr = [b65536].End(xlUp).Row
    
11.     Myc = [iv4].End(xlToLeft).Column
    
12.     For i = 4 To Myr Step 4
    
13.     For j = 2 To Myc Step 2
    
14.         Set rng = Cells(i, j).Offset(-1, 0)
    
15.         With rng
    
16.             ML = .Left
    
17.             MT = .Top
    
18.             MW = .Width
    
19.             MH = .Height
    
20.             ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
    
21.             Selection.ShapeRange.Fill.UserPicture _
    
22.                 ThisWorkbook.Path & "" & Cells(i, j).Value & ".jpg"
    
23.         End With
    
24.     Next
    
25.     Next
    
26.     [a1].Select
    
27.     If Err.Number <> 0 Then Err.Clear: On Error GoTo 0
    
28. End Sub
    

复制代码

蓝桥玄霜

请见附件。

晓山青

非常感谢老师指点。只是还想请教一下老师，代码的后半部分我基本上可以理解，但是前面的几行我还是不太明白。这个是定义了一个范围吗？
Sub cartup()
    Dim rng As Range, ML, MT, MW, MH, shp As Shape, Myc%, Myr&, i&, j&
    On Error Resume Next
再有，我想去掉图片的边框，不知道怎样修改代码？麻烦老师啦。
   

gateun

蓝桥玄霜 发表于 2013-2-26 14:52
请见附件。

shape如何改为addpicture，因为shape手机点图片不能查看原图！请上附件，谢谢大师！