Excel VBA：将用户选择的图像从用户表单传输到具有保守纵横比和响应式适配的工作表

Question

我正在使用 VBA 在 Excel 中创建一个用户表单，该表单接受用户选择的图像。当用户提交包含所选图像的表单时，用户表单旨在将图像放入连接的工作表的 A 列中，以便保持图像的长宽比，并且图像和单元格适合在一起，就像图片和图片一样框架。

我尝试了以下代码：

Dim EmptyRow As Long

'Make the Appointments worksheet active
Worksheets("Appointments").Activate

'Determine the empty row
EmptyRow = WorksheetFunction.CountA(Range("B:B")) + 1

'Insert and format photo
Set photo = ActiveSheet.Pictures.Insert(ImagePath)
With photo

    .Left = ActiveSheet.Cells(EmptyRow, 1).Left
    .Top = ActiveSheet.Cells(EmptyRow, 1).Top
    
    With .ShapeRange
        .LockAspectRatio = msoTrue
        .Width = ActiveSheet.Columns("A").ColumnWidth
    End With
    
    'Set the format of the picture cell
    ActiveSheet.Rows(EmptyRow).RowHeight = photo.ShapeRange.Height
    
    .Placement = 1
    
End With

插入时，图像宽度不会设置为它们所在单元格的宽度。调整图像/单元格尺寸时，不会保持图像长宽比，并且图像/单元格宽度/高度不会更改以适合单元格/图像。

插入时，我期望包含图像的单元格充当图像的相框。换句话说，我在期待

1. 要保留图像的长宽比，
2. 图像宽度等于包含它的列的宽度，
3. 并且包含它的行的高度等于图像高度。

更改图像/单元尺寸后，我期望单元/图像的尺寸发生变化，使得

1. 保持图像/单元格的纵横比，
2. 以及图像/单元格的尺寸以适应变化。

Answer 1

您的代码即将完成。唯一的改变应该是

    With .ShapeRange
        .LockAspectRatio = msoTrue
        .Width = Cells(EmptyRow, 1).Width
    End With

一个单位的列宽等于普通样式中一个字符的宽度。

请参考微软文档。

Range.ColumnWidth 属性 (Excel)