2个回答
展开全部
打开Excel后在查看“宏”里新建一个宏会弹出VB编辑器(或直接打开VB编辑器),输入以下代码并运行该代码:
Sub LoadImage()
Dim HLK As Hyperlink, Rng As Range
For Each HLK In ActiveSheet.Hyperlinks '循环活动工作表中的各个超链接
If UCase(HLK.Address) Like "*.JPG" Or UCase(HLK.Address) Like "*.JPEG" Or UCase(HLK.Address) Like "*.PNG" Or UCase(HLK.Address) Like "*.GIF" Then '如果链接的位置是jpg或gif图片(此处仅针对此两种图片类型,更多类型可以通过建立数组或字典或正则来判断)
Set Rng = HLK.Parent.Offset(, 0) '设定插入目标图片的位置
With ActiveSheet.Pictures.Insert(HLK.Address) '插入链接地址中的图片
If .Height / .Width > Rng.Height / Rng.Width Then '判断图片纵横比与单元格纵横比的比值以确定针对单元格缩放的比例
.Top = Rng.Top
.Left = Rng.Left + (Rng.Width - .Width * Rng.Height / .Height) / 2
.Width = .Width * Rng.Height / .Height
.Height = Rng.Height
Else
.Left = Rng.Left
.Top = Rng.Top + (Rng.Height - .Height * Rng.Width / .Width) / 2
.Height = .Height * Rng.Width / .Width
.Width = Rng.Width
End If
End With
HLK.Parent.Value = "" '删除单元格的图片链接
End If
Next
End Sub
Sub LoadImage()
Dim HLK As Hyperlink, Rng As Range
For Each HLK In ActiveSheet.Hyperlinks '循环活动工作表中的各个超链接
If UCase(HLK.Address) Like "*.JPG" Or UCase(HLK.Address) Like "*.JPEG" Or UCase(HLK.Address) Like "*.PNG" Or UCase(HLK.Address) Like "*.GIF" Then '如果链接的位置是jpg或gif图片(此处仅针对此两种图片类型,更多类型可以通过建立数组或字典或正则来判断)
Set Rng = HLK.Parent.Offset(, 0) '设定插入目标图片的位置
With ActiveSheet.Pictures.Insert(HLK.Address) '插入链接地址中的图片
If .Height / .Width > Rng.Height / Rng.Width Then '判断图片纵横比与单元格纵横比的比值以确定针对单元格缩放的比例
.Top = Rng.Top
.Left = Rng.Left + (Rng.Width - .Width * Rng.Height / .Height) / 2
.Width = .Width * Rng.Height / .Height
.Height = Rng.Height
Else
.Left = Rng.Left
.Top = Rng.Top + (Rng.Height - .Height * Rng.Width / .Width) / 2
.Height = .Height * Rng.Width / .Width
.Width = Rng.Width
End If
End With
HLK.Parent.Value = "" '删除单元格的图片链接
End If
Next
End Sub
展开全部
假设链接在A列(A2开始)
Sub 宏11()
Application.ScreenUpdating = False
For i = 2 To Range("A65536").End(xlUp).Row
Cells(i, 1).RowHeight = 100 '设置行高为100
Cells(i, 1).Select
ActiveSheet.Pictures.Insert(Cells(i, 1).Value).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = Cells(i, 1).Height '设置图片高度为单元格行高
Cells(i, 1).ClearContents
Next
Application.ScreenUpdating = True
End Sub
Sub 宏11()
Application.ScreenUpdating = False
For i = 2 To Range("A65536").End(xlUp).Row
Cells(i, 1).RowHeight = 100 '设置行高为100
Cells(i, 1).Select
ActiveSheet.Pictures.Insert(Cells(i, 1).Value).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = Cells(i, 1).Height '设置图片高度为单元格行高
Cells(i, 1).ClearContents
Next
Application.ScreenUpdating = True
End Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询
广告 您可能关注的内容 |