VBA代码中设置插入图片大小的问题－急求解！！

jiang_619

设置了法人照片、门面照片、柜台照片插入表格的固定尺寸，可插入后图片超出表格设置尺寸了怎么办啊？
Sub 批量填充客户3项照片6()
'
Dim i As Integer
Dim fr As Integer
Dim mm As Integer
Dim gt As Integer
Dim zhenhao As Integer
For i = 1 To 3
zhenhao = i * 15 - 11
fr = i * 15 - 12
mm = i * 15 - 12
gt = i * 15 - 6
Range("t" & fr).Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Range("C" & zhenhao) & "FR.jpg").Select
With Selection.ShapeRange
    .LockAspectRatio = msoTrue
    .Height = 147
    .Width = 88
    End With
   
Range("y" & mm).Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Range("C" & zhenhao) & "MM.jpg").Select
With Selection.ShapeRange
    .LockAspectRatio = msoTrue
    .Height = 294
    .Width = 440
    End With
   
Range("y" & gt).Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Range("C" & zhenhao) & "GT.jpg").Select
With Selection.ShapeRange
    .LockAspectRatio = msoTrue
    .Height = 294
    .Width = 440
    End With
Next i
End Sub

李甲

要么是将表格拉大，要么是将图片缩小

dsmch

1. Dim rng As Range 'rng为图片放入单元格范围
   
2. Set rng = [a1:c10]
   
3.     rng(1).Select
   
4.     ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "" & Range("C" & zhenhao) & "FR.jpg").Select
   
5.     w = rng.Width
   
6.     h = rng.Height
   
7.     Selection.ShapeRange.LockAspectRatio = msoFalse
   
8.     Selection.ShapeRange.Height = h
   
9.     Selection.ShapeRange.Width = w
   

复制代码

grf1973

把 .LockAspectRatio = msoTrue 改成 msoFalse就行了，这是锁定横宽比的。

jiang_619

谢谢高的指点！！{:soso_e181:}