|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 hecaodong 于 2019-9-5 14:53 编辑
- Option Explicit
- 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 to the range of cells you want to change to pictures
- Set rng = ActiveSheet.Range("D2:D3")
- For Each cell In rng
- Filename = cell
- ' Use Shapes instead so that we can force it to save with the document
- Set theShape = ActiveSheet.Shapes.AddPicture( _
- Filename:=Filename, linktofile:=msoFalse, _
- savewithdocument:=msoCTrue, _
- Left:=cell.Left, Top:=cell.Top, Width:=60, Height:=60)
- If theShape Is Nothing Then GoTo isnill
- With theShape
- .LockAspectRatio = msoTrue
- ' Shape position and sizes stuck to cell shape
- .Top = cell.Top + 1
- .Left = cell.Left + 1
- .Height = cell.Height - 2
- .Width = cell.Width - 2
- ' Move with the cell (and size, though that is likely buggy)
- .Placement = xlMoveAndSize
- End With
- ' Get rid of the
- cell.ClearContents
- isnill:
- Set theShape = Nothing
- Range("D2").Select
- Next
- Application.ScreenUpdating = True
- Debug.Print "Done " & Now
- End Sub
复制代码 https://www.revolvecn888.com/images/p4/n/d/AGOL-WJ95_V1.jpg
这个链接 不能用上述 VBA 中的 shapes.addpicture 导入到Excel, 其他链接可以。 不知道为什么?
麻烦老铁给看看!
```
```
|
|