[已解决]菜鸟寻求帮忙改代码！

hhss123

菜鸟寻求帮忙改代码！谢谢！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-10-21 15:08

hhss123 发表于 2012-10-21 14:56
老大最终确定是10楼的代码吗！

11楼的吧。越是后面贴的，就越好点。

跳转到最佳答案楼层

hwc2ycy

不用改，10里能用。

hwc2ycy

不过有点小问题，原来的不会清除，还有就是大小的问题。

hwc2ycy

pictures得改成图片了。

hwc2ycy

原有的那句改为

1. If InStr(.Name, "图片") > 0 Then .Delete

复制代码

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim oShp As Shape
   
3.     Dim rng As Range, sPic As String
   
4.     For Each oShp In Shapes
   
5.         With oShp
   
6.             If .Name Like "*Picture*" Or .Name Like "*图片*" Then .Delete
   
7.         End With
   
8.     Next
   
9.     Application.ScreenUpdating = False
   
10.     For Each rng In Range("a2:a" & [a65536].End(xlUp).Row)
    
11.         sPic = ThisWorkbook.Path & "" & rng & ".jpg"
    
12.         If Dir(sPic) <> "" Then
    
13.             Pictures.Insert(sPic).Select
    
14.             Selection.ShapeRange.LockAspectRatio = msoFalse
    
15.             With rng
    
16.                 Selection.Left = .Offset(0, 3).Left + 2
    
17.                 Selection.Top = .Offset(0, 3).Top + 2
    
18.                 Selection.Height = .Offset(0, 3).Height - 2
    
19.                 Selection.Width = .Offset(0, 3).Width - 2
    
20.             End With
    
21.         End If
    
22.     Next
    
23.     Application.ScreenUpdating = True
    
24.     [d1].Select
    
25. End Sub

复制代码

hwc2ycy

奇怪，有时是图片，有时是PICTURE，直接都判断得了，然后去掉了锁定纵横比。
不然就得把行高根据图片的高度来设置了。

hwc2ycy

03 里显示名字是图片

hwc2ycy

在10里新添加的图片是picture，原有的图片在未删之前是图片X 类似的名字

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim oShp As Shape
   
3.     Dim rng As Range, sPic As String
   
4.     For Each oShp In Shapes
   
5.         With oShp
   
6.             If .Name Like "*Picture*" Or .Name Like "*图片*" Then .Delete
   
7.         End With
   
8.     Next
   
9.     Application.ScreenUpdating = False
   
10.     For Each rng In Range("a2:a" & [a65536].End(xlUp).Row)
    
11.         sPic = ThisWorkbook.Path & "" & rng & ".jpg"
    
12.         If Dir(sPic) <> "" Then
    
13.             Pictures.Insert(sPic).Select
    
14.             'Selection.ShapeRange.LockAspectRatio = msoFalse
    
15.             With rng
    
16.                 Selection.Left = .Offset(0, 3).Left + 2
    
17.                 Selection.Top = .Offset(0, 3).Top + 2
    
18.                 'Selection.Height = .Offset(0, 3).Height - 2
    
19.                 Selection.Width = .Offset(0, 3).Width - 2
    
20.                 .RowHeight = Selection.Height + 4
    
21.             End With
    
22.         End If
    
23.     Next
    
24.     Application.ScreenUpdating = True
    
25.     [d1].Select
    
26. End Sub

复制代码

10里图片由于默认是锁定纵横比的，所以一旦设置了宽度，图片的高度就会根据比例自动缩小。
再来设置图片的高度就无意义。
通过修改单元格的行高来适应图片的高度。这样图片的比例一致，相对于原图来说不会有失真。