如何在合并后的单元格内插入图片

廿四/ty笔划

新手小白，不太懂VBA、


当一个产品有N个尺寸时，只想在这一个产品后方插入一个产品标准图片如何实现？（因为相同产品尺寸不同时，图片都是一样的），之前一直通过在单一产品的尺寸后方插入匹配，但这种方式，后方图片特别多，且不美观，同时EXCEL也会因为一个产品被重复插入N张图片变的很大，效率很低。

请教一下，如何在合并的单元格内插入图片，
最好能同步实现，当合并单元格高度不一时， 被插入的图片能按原始比例，依据后方单元格的宽度，自然匹配比例适合的高度，
我在各论坛上收集了几段零星的代码，最后做了一个这个半成品，然后就卡住了。。

titi012

参与一下，楼主的代码有点问题，活动单元格这里不对，不能这样来的。

1. Private Sub CommandButton1_Click()
   
2.    
   
3.     Rem 删除原有图片
   
4.     Dim Shap As Shape
   
5.     For Each Shap In Shapes
   
6.         If Shap.Type = msoAutoShape Then Shap.Delete
   
7.     Next
   
8.    
   
9.     Dim Arr
   
10.     Dim i As Long
    
11.     Dim j  As Long
    
12.     Dim r As Long
    
13.     Dim m As Long
    
14.     Dim H, W, L, T
    
15.     r = Cells(Rows.Count, 1).End(xlUp).Row
    
16.     Arr = Range("a1:c" & r + 1)
    
17.     Arr(r + 1, 3) = 0
    
18.     For i = 2 To r
    
19.         If Arr(i, 3) <> "" Then
    
20.             For j = i + 1 To UBound(Arr)
    
21.                 If Arr(j, 3) <> "" Then m = j - 1: Exit For
    
22.             Next j
    
23.             With Range("c" & i & ":c" & m)
    
24.                 .Merge
    
25.                 L = .Left
    
26.                 T = .Top
    
27.                 W = .Width
    
28.                 H = .Height
    
29.                 .Select
    
30.             End With
    
31.             ActiveSheet.Shapes.AddShape(msoShapeRectangle, L, T, W, H).Select
    
32.             Selection.ShapeRange.Fill.UserPicture ActiveWorkbook.Path & "\图片目录" & Arr(i, 3) & ".jpg"
    
33.         End If
    
34.     Next i
    
35.    
    
36. End Sub

复制代码