已自行解决 ：VBA 图片失真，请教嵌入图片

zglibk

老师，请问你段代码要怎么修改才能是原图效果，现在插入的图片被压缩了
谢谢！

1. Private Sub CommandButton5_Click()
   
2. Dim rng, wj, i As Integer
   
3. 
   
4.     If Len(ComboBox1.Text) = 0 Then MsgBox "请输入订单号！", vbCritical, "提示": Exit Sub
   
5.     If Len(ComboBox2.Text) = 0 Then MsgBox "请选择区域！", vbCritical, "提示": Exit Sub
   
6.     With Application.FileDialog(msoFileDialogFilePicker)
   
7.      .Title = "选择图片"
   
8.         '默认打开的文件对话框路径
   
9.         '.InitialFileName = "d:"
   
10.     If .Show Then
    
11.         '获取到路径
    
12.          wj = .SelectedItems(1)
    
13.     End If
    
14.     End With
    
15.    
    
16.     i = Sheets("销售记录").Cells(Rows.Count, 1).End(3).row
    
17.     Set rng = Cells(i, 8)
    
18.     ActiveSheet.Shapes.AddPicture(wj, True, True, rng.Left, rng.Top, rng.Width, rng.Height).Placement = xlMoveAndSize
    
19. End Sub

复制代码

rardge2015

我没用 VBA 操作过图片，仅以 PPT 的经验解答。
若要图片不失真，又能放大缩小，只能同比例调节图片的长宽（保持长宽比）。
我看最后一条代码，强迫照片调整成单元格的高度和宽度，可能就是这个问题导致失真。比如一张横屏的照片，非要调整成竖屏，自然就失真了。
若程序必须保持单元格的固定高度和宽度，那就只有从源头解决了，每张照片的长宽比要和单元格的长宽比保持一致。

zglibk

rardge2015 发表于 2019-9-1 22:27
我没用 VBA 操作过图片，仅以 PPT 的经验解答。
若要图片不失真，又能放大缩小，只能同比例调节图片的长宽 ...

可是图片不能裁切，又要缩放到单元格大小，网上查了也没找到可行的方法

ahn

之前帮他人实现过的典型例子：

从其它工作簿拷贝信息和图片
链接:https://pan.baidu.com/s/1zBmNb9xx5BWHj_e0FJF7qQ  提取码: n813

批量插入图片——递归子目录并支持多种图片格式
链接: https://pan.baidu.com/s/17DVBX_FGTG1aZKLrNg8gsg  提取码: 7fv1

批量插入图片——有合并单元格，图片垂直水平居中并维持宽高比
链接: https://pan.baidu.com/s/119h4Y5Qj_UgFb6nBtwMZtA  提取码: 9zj2

批量插入图片——插入含关键字的所有图片
链接: https://pan.baidu.com/s/1T7ZgI3AOYns4yqiIajlxfw  提取码: qmjh

批量插入图片——插入批注图片并维持宽高比
链接: https://pan.baidu.com/s/1AW7YncFs27t0dZZV--CasQ  提取码: csqu

zglibk

4楼这位老师发的是运行界面的视频和gif，代码都没有看到一个