如何在 Excel 中插入SVG矢量图标文件

如何在 Excel 中插入SVG矢量图标文件,第1张

这个是EXCEL的插入对象功能实现的。1、鼠标点到需要插入的位置,点击插入功能;2、插入子功能的右方“公式”左边有个“对象”,点击该按钮;3、点击“由文件创建“,浏览选中需要插入的文件,并选择显示为图片;

Sub 单元格自动插入图片()

'选定起始单元格后,按一定行数(1-n)自动往返插入各种格式的图片,

'并在单元格中写入插入图片的名称。

Pf = "ai,"

Pf = Pf &"bmp,bmz"

Pf = Pf &"cdr,cgm,"

Pf = Pf &"dib,dwg,dxf,"

Pf = Pf &"emf,emz,eps,exf,exif,"

Pf = Pf &"fpx,"

Pf = Pf &"gfa,gif,"

Pf = Pf &"hdr,"

Pf = Pf &"ico,"

Pf = Pf &"jfif,jpe,jpeg,jpg,"

Pf = Pf &"pcd,pct,pcx,pcz,pict,png,psd,"

Pf = Pf &"raw,rle,"

Pf = Pf &"svg,"

Pf = Pf &"tga,tif,tiff,"

Pf = Pf &"ufo,"

Pf = Pf &"wdp,wmf,wmz,"

K = InputBox("插入行数,1=按列挿入", "插入行数", 1)

If K = "" Then Exit Sub

Dim Rng As Range: Set Rng = ActiveCell

OpenFile = Application.GetOpenFilename("Picture Files(*.*),*.*", , "打开目标文件夹后选择任一图片即可指定文件夹。或按取消则会将当前文件所在文件夹认作指定文件夹。")

If OpenFile = False Then

myDir = ThisWorkbook.Path &"\"

Else

myDir = Left(OpenFile, InStrRev(OpenFile, "\"))

End If

Filename = Dir(myDir)

Application.ScreenUpdating = False

Do While Filename <>""

If InStr(Pf, LCase(Right(Filename, Len(Filename) - InStrRev(Filename, ".")))) >0 Then

Rng.Cells(1 + n \ K, n Mod K + 1).Select

ActiveCell = Left(Filename, InStrRev(Filename, ".") - 1)

ActiveSheet.Pictures.Insert(myDir &Filename).Select

With Selection

.Placement = xlMoveAndSize

.ShapeRange.LockAspectRatio = msoFalse

.Top = ActiveCell.Top

.Left = ActiveCell.Left

.Height = ActiveCell.Height

.Width = ActiveCell.Width

End With

n = n + 1

End If

Filename = Dir

Loop

Application.ScreenUpdating = True

Rng.Select

End Sub


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/bake/11632955.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-17
下一篇 2023-05-17

发表评论

登录后才能评论

评论列表(0条)

保存