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

**Published by:** [My Wolrd](https://paragraph.com/@my-wolrd/)
**Published on:** 2022-07-09
**URL:** https://paragraph.com/@my-wolrd/excel-vba

## Content

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

## Publication Information

- [My Wolrd](https://paragraph.com/@my-wolrd/): Publication homepage
- [All Posts](https://paragraph.com/@my-wolrd/): More posts from this publication
- [RSS Feed](https://api.paragraph.com/blogs/rss/@my-wolrd): Subscribe to updates