# Excel表格图片链接显示图片vba代码

By [My Wolrd](https://paragraph.com/@my-wolrd) · 2022-07-09

---

    Sub URLPictureInsert()
    Dim Pshp As Shape
    Dim xRg As Range
    Dim xCol As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    Set Rng = ActiveSheet.Range("A1:A4")
    For Each Cell In Rng
    filenam = Cell
    ActiveSheet.Pictures.Insert(filenam).Select
    Set Pshp = Selection.ShapeRange.Item(1)
    If Pshp Is Nothing Then GoTo lab
    xCol = Cell.Column + 1
    Set xRg = Cells(Cell.Row, xCol)
    With Pshp
    .LockAspectRatio = msoFalse
    If .Width > xRg.Width Then .Width = xRg.Width * 2 / 3
    If .Height > xRg.Height Then .Height = xRg.Height * 2 / 3
    .Top = xRg.Top + (xRg.Height - .Height) / 2
    .Left = xRg.Left + (xRg.Width - .Width) / 2
    End With
    lab:
    Set Pshp = Nothing
    Range("A2").Select
    Next
    Application.ScreenUpdating = True
    End Sub

---

*Originally published on [My Wolrd](https://paragraph.com/@my-wolrd/excel-vba)*