0

一段时间以来，我一直在尝试构建一个代码来在 Excel 的单元格中插入图片，到目前为止的结果非常好。感谢此网页上的几篇文章，例如：

使用宏vba插入图片以采用合并单元格或单个单元格

VBA将图片插入表格的特定列

如何使用VBA在指定单元格位置将图片插入Excel

使用VBA将图片插入Excel并保持纵横比不超过尺寸

获取图片大小

我发现，当我尝试调整垂直格式为 4:3 或 16:9 的图片时，它不起作用。照片的高度大于单元格的高度。

另外，当我直接用 获取图片的尺寸时VBA，代码的结果是宽度大于高度。但是，有趣的部分来了，如果我只剪一点照片，它会像往常一样工作。该代码将起作用并且尺寸正确。

不知何故，这些格式为 4:3 或 16:9，当格式为垂直时，Excel 会交换照片的尺寸。有谁知道为什么会发生这样的事情？

更新：这是我正在使用的代码以及其中一张图片的链接。

    Sub Pictures()
      
    Dim wb As Workbook
    Set wb = ActiveWorkbook
        
    counter = 0
    
        strCompFilePath = wb.Sheets("List").Cells(1, 1)
            If strCompFilePath <> "" Then
                counter = counter + 1
                Sheets("Template").Activate
                Sheets("Template").Range("A" & counter).RowHeight = 250
                Call Insert(strCompFilePath, counter)
            End If
                                    
    End Sub
    Function Insert(PicPath, counter)
    
        Dim l, r, t, b
        Dim w, h      ' width and height of range into which to fit the picture
        Dim aspect     ' aspect ratio of inserted picture
    
        l = 1: r = 8    ' co-ordinates of top-left cell
        t = counter: b = counter    ' co-ordinates of bottom-right cell
    
        With Sheets("Template").Pictures.Insert(PicPath)
            With .ShapeRange
                 .LockAspectRatio = msoTrue
                .Width = Range("H" & counter).Left + Range("H" & counter).Width - Range("A" & counter).Left
                .Height = Range("H" & counter).Top + Range("H" & counter).Height - Range("A" & counter).Top
                aspect = .Width / .Height     ' calculate aspect ratio of picture
                .Top = Range("A" & counter).Top + (Range("A" & counter).Height - .Height) / 2                 'left placement of picture
                .Left = Range("A" & counter).Left + Range("A:H").Left + (Range("A:H").Width - .Width) / 2     'top left placement of picture
            End With
            .Placement = 1 'Object is moved and sized with the cells
            .PrintObject = True
        End With
        
    End Function

在此处输入图像描述

在此处输入图像描述

更新：感谢@RaymonWu，这是更新的代码：

Sub Pictures()
  
Dim wb As Workbook
Set wb = ActiveWorkbook
    
counter = 5

    strCompFilePath = wb.Sheets("List").Cells(1, 1)
        If strCompFilePath <> "" Then
            counter = counter + 1
            Sheets("Template").Activate
            Sheets("Template").Range("A" & counter).RowHeight = 250
            Call Insert(strCompFilePath, counter)
        End If
                                
End Sub
Function Insert(PicPath, counter)

With Sheets("Template").Pictures.Insert(PicPath)
    With .ShapeRange
        .LockAspectRatio = msoTrue
        .Height = 250
        .Top = Range("A" & counter).Top + (Range("A" & counter).Height - 
.Height) / 2                 'left placement of picture
        .Left = Range("A" & counter).Left + Range("A:H").Left + 
(Range("A:H").Width - .Width) / 2     'top left placement of picture
    End With
        .Placement = 1 'Object is moved and sized with the cells
        .PrintObject = True
    End With
    
End Function

并且这条线.Height = 250实际上不起作用。我开始认为代码本身没有问题，但 Excel。不知何故，它将图像的宽度识别为高度，反之亦然。

4

0 回答 0