☰

从 Excel 中的 URL 导入图像，并将其存储在文件本身中

tag-icon • tag-icon microsoft-excel vba
从 Excel 中的 URL 导入图像，并将其存储在文件本身中

我正在使用下面的 VBA 代码将图像从 URL 导入到我的 excel 并将它们存储到文件本身。我无法解决的问题是它们保持了纵横比，但它们没有在我的单元格中居中显示，我每次都必须调整它们的大小。有什么建议吗？

Dim rng As Range
Dim cell As Range
Dim Filename As String

Sub URLPictureInsert()
    Dim theShape As Shape
    Dim xRg As Range
    Dim xCol As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    Set rng = ActiveSheet.Range("F2:F500")
    For Each cell In rng
        Filename = cell
        Set theShape = ActiveSheet.Shapes.AddPicture( _
            Filename:=Filename, linktofile:=msoFalse, _
            savewithdocument:=msoCTrue, _
            Left:=cell.Left, Top:=cell.Top, Width:=-1, Height:=-1)
        If theShape Is Nothing Then GoTo isnill
        With theShape
            .LockAspectRatio = msoTrue
            .Top = cell.Top - 1
            .Left = cell.Left - 1
            .Height = cell.Height - 1
            .Width = cell.Width - 1
        End With
        cell.ClearContents
isnill:
        Set theShape = Nothing
        Range("f2").Select

    Next
    Application.ScreenUpdating = True

    Debug.Print "Done " & Now

End Sub```

答案1

欢迎！

设置后.LockAspectRatio = msoTrue，无需更改两个参数 - 高度和宽度。例如，更改高度 - 图像的宽度将自动更改。检查如此宽的图像是否适合单元格。如果不适合，则更改宽度，高度将进一步减小。现在对齐单元格中间发生的事情。尝试With theShape...End With用此代码片段替换代码块：

        With theShape
            .LockAspectRatio = msoTrue
            .Height = cell.Height - 2
            If .Width > cell.Width Then
                .Width = cell.Width - 2
            End If
            .Top = cell.Top + 1
            .Left = cell.Left + (cell.Width - .Width) / 2
        End With

相关内容