Excel插入批量圖片套用的代碼怎么寫

本篇文章為大家展示了Excel插入批量圖片套用的代碼怎么寫，內(nèi)容簡(jiǎn)明扼要并且容易理解，絕對(duì)能使你眼前一亮，通過(guò)這篇文章的詳細(xì)介紹希望你能有所收獲。

咱們今天分享的內(nèi)容是按指定名稱和位置批量將圖片插入到Excel工作表中

看個(gè)動(dòng)畫先：

代碼如下

Sub InsertPic()     'ExcelHome VBA編程學(xué)習(xí)與實(shí)踐 by:看見(jiàn)星光     Dim Arr, i&, k&, n&, pd&     Dim strPicName$, strPicPath$, strFdPath$, shp As Shape     Dim Rng As Range, Cll As Range, Rg As Range, strWhere As String     'On Error Resume Next     '用戶選擇圖片所在的文件夾     With Application.FileDialog(msoFileDialogFolderPicker)        If .Show Then strFdPath = .SelectedItems(1) Else: Exit Sub     End With     If Right(strFdPath, 1) <> "\" Then strFdPath = strFdPath & "\"     Set Rng = Application.InputBox("請(qǐng)選擇圖片名稱所在的單元格區(qū)域", Type:=8)     '用戶選擇需要插入圖片的名稱所在單元格范圍     Set Rng = Intersect(Rng.Parent.UsedRange, Rng)     'intersect語(yǔ)句避免用戶選擇整列單元格，造成無(wú)謂運(yùn)算的情況     If Rng Is Nothing Then MsgBox "選擇的單元格范圍不存在數(shù)據(jù)！": Exit Sub     strWhere = InputBox("請(qǐng)輸入圖片偏移的位置，例如上1、下1、左1、右1", , "右1")     '用戶輸入圖片相對(duì)單元格的偏移位置。     If Len(strWhere) = 0 Then Exit Sub     x = Left(strWhere, 1)     '偏移的方向     If InStr("上下左右", x) = 0 Then MsgBox "你未輸入偏移方位。": Exit Sub     y = Val(Mid(strWhere, 2))     '偏移的值     Select Case x         Case "上"         Set Rg = Rng.Offset(-y, 0)         Case "下"         Set Rg = Rng.Offset(y, 0)         Case "左"         Set Rg = Rng.Offset(0, -y)         Case "右"         Set Rg = Rng.Offset(0, y)     End Select     Application.ScreenUpdating = False     Rng.Parent.Select     For Each shp In ActiveSheet.Shapes     '如果舊圖片存放在目標(biāo)圖片存放范圍則刪除         If Not Intersect(Rg, shp.TopLeftCell) Is Nothing Then shp.Delete     Next     x = Rg.Row - Rng.Row     y = Rg.Column - Rng.Column     '偏移的坐標(biāo)     Arr = Array(".jpg", ".jpeg", ".bmp", ".png", ".gif")     '用數(shù)組變量記錄五種文件格式     For Each Cll In Rng     '遍歷選擇區(qū)域的每一個(gè)單元格         strPicName = Cll.Text         '圖片名稱         If Len(strPicName) Then         '如果單元格存在值             strPicPath = strFdPath & strPicName             '圖片路徑             pd = 0             'pd變量標(biāo)記是否找到相關(guān)圖片             For i = 0 To UBound(Arr)             '由于不確定用戶的圖片格式，因此遍歷圖片格式                 If Len(Dir(strPicPath & Arr(i))) Then                 '如果存在相關(guān)文件                     Set shp = ActiveSheet.Shapes.AddPicture( _                         strPicPath & Arr(i), False, True, _                         Cll.Offset(x, y).Left + 5, _                         Cll.Offset(x, y).Top + 5, _                         20, 20)                     shp.Select                     With Selection                         .ShapeRange.LockAspectRatio = msoFalse                         '撤銷鎖定圖片縱橫比                         .Height = Cll.Offset(x, y).Height - 10 '圖片高度                         .Width = Cll.Offset(x, y).Width - 10 '圖片寬度                     End With                     pd = 1 '標(biāo)記找到結(jié)果                     n = n + 1 '累加找到結(jié)果的個(gè)數(shù)                     [a1].Select: Exit For '找到結(jié)果后就可以退出文件格式循環(huán)                 End If             Next             If pd = 0 Then k = k + 1 '如果沒(méi)找到圖片累加個(gè)數(shù)         End If     Next     Application.ScreenUpdating = True     MsgBox "共處理成功" & n & "個(gè)圖片，另有" & k & "個(gè)非空單元格未找到對(duì)應(yīng)的圖片。" End Sub

代碼已有注釋說(shuō)明，這兒就再說(shuō)明一下運(yùn)行過(guò)程。

首先，會(huì)讓用戶選擇存放圖片的文件夾。注意是選擇文件夾，不是選擇圖片;選擇文件夾后，看不到文件夾內(nèi)的圖片是正?，F(xiàn)象。

然后，選擇圖片名稱存放的單元格區(qū)域，可以選擇整列、多列、整行或多行，比如示例動(dòng)畫中的B:D列，2:2行等。。

最后，設(shè)置圖片相對(duì)于圖片名稱所在的單元格便宜的位置;比如圖片名稱在B列，圖片放在C列，那就是向右偏移1列，即右1。上下左右代表了方向，數(shù)字代表偏移的量。

小貼士：

1. 該段小代碼支持一下圖片格式：".jpg", ".jpeg", ".bmp", ".png", ".gif"

2. 圖片的縱橫比是未鎖定的，如需鎖定，可以注釋掉下句代碼：.ShapeRange.LockAspectRatio = msoFalse

3. 圖片的行高和列寬是由放置圖片的單元格行高和列寬決定的。當(dāng)然，您也可以把代碼稍微修改，設(shè)置固定的圖片行高和列寬，并由圖片的行高和列寬決定單元格的大小。

4. 圖片的名稱必須和指定單元格范圍內(nèi)的名稱一致，如果需要模糊匹配，使用DIR函數(shù)搭配通配符的方式即可。

5. 代碼采用非引用的方式插入圖片，該方式會(huì)圖片作為excel的資源打包到excel文件中，即便數(shù)據(jù)源的圖片已被刪除，表格中的圖片也依然存在。

上述內(nèi)容就是Excel插入批量圖片套用的代碼怎么寫，你們學(xué)到知識(shí)或技能了嗎？如果還想學(xué)到更多技能或者豐富自己的知識(shí)儲(chǔ)備，歡迎關(guān)注億速云行業(yè)資訊頻道。