當(dāng)鼠標(biāo)滑過單元格時(shí)，Excel就會(huì)自動(dòng)顯示相關(guān)圖片……
當(dāng)鼠標(biāo)滑過單元格時(shí)，Excel就會(huì)自動(dòng)顯示相關(guān)圖片……
AhaExcel
建議常用Excel的職場(chǎng)人關(guān)注，海量教程隨學(xué)隨用，隨用隨查。 主創(chuàng)：看見星光，微軟全球最有價(jià)值專家、Excel圖書作者、培訓(xùn)師。 內(nèi)容：每日四文，一篇函數(shù)教程、一篇VBA教程、一個(gè)短視頻小技巧、一篇雜文。
以下文章來源于VBA編程學(xué)習(xí)與實(shí)踐 ，作者EH看見星光
ExcelHome技術(shù)論壇下屬VBA版塊公眾號(hào)，Excel易用寶+VBA代碼寶激活碼免費(fèi)發(fā)放，日常分享Excel VBA編程學(xué)習(xí)與實(shí)踐中的點(diǎn)點(diǎn)滴滴。
哈嘍，我是星光。今天給大家分享一段 復(fù)制即可使用 的VBA小代碼；作用是 將指定文件夾內(nèi)的圖片，根據(jù)名稱，批量插入到Excel工作表的批注中 。
這么做有什么好處呢？當(dāng)鼠標(biāo)滑過單元格時(shí)，Excel就會(huì)自動(dòng)顯示圖片了，很實(shí)用，看起來也很酷~
實(shí)際效果如下圖所示▼
、
▲如何運(yùn)行VBA代碼？其實(shí)很簡(jiǎn)單
Sub AddCommentPic()
Dim arr, i&, k&, n&, b As Boolean
Dim strPicName$, strPicPath$, strFdPath$
Dim rngData As Range, rngEach As Range
’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 rngData = Application.InputBox(
"請(qǐng)選擇需要插入圖片到批注中的單元格區(qū)域"
, Type:=
8
)
’用戶選擇需要插入圖片到批注中的單元格或區(qū)域
If rngData.Count = 0 Then Exit Sub
Set rngData = Intersect(rngData.Parent.UsedRange, rngData)
’
intersect語句避免用戶選擇整列單元格，造成無謂運(yùn)算的情況
If
rngData Is Nothing Then MsgBox
"選擇單元格不能全為空。"
:
Exit
Sub
arr = Array(
".jpg"
,
".jpeg"
,
".bmp"
,
".png"
,
".gif"
)
’用數(shù)組變量記錄五種文件格式
Application.ScreenUpdating = False
For Each rngEach In rngData
’
遍歷選擇區(qū)域的每一個(gè)單元格
If
Not rngEach.Comment Is Nothing Then rngEach.Comment.Delete
’刪除舊的批注
strPicName = rngEach.Text ’
圖片名稱
If
Len(strPicName) Then
’如果單元格存在值
strPicPath = strFdPath & strPicName ’
圖片路徑
b = False
’pd變量標(biāo)記是否找到相關(guān)圖片
For i = 0 To UBound(arr)
’
由于不確定用戶的圖片格式，因此遍歷圖片格式
If
Len(Dir(strPicPath & arr(i))) Then
’如果存在相關(guān)文件
rngEach.AddComment ’
增加批注
With rngEach.Comment
.Visible = True
’批注可見
.Text Text:=""
.Shape.Select True ’
選中批注圖形
Selection.ShapeRange.Fill.UserPicture strPicPath & arr(i)
’插入圖片到批注中
.Shape.Height = 150 ’
圖形的高度，可以根據(jù)需要自己調(diào)整
.Shape.Width =
150
’圖形的寬度，可以根據(jù)需要自己調(diào)整
.Visible = False ’
取消顯示
End
With
b = True
’標(biāo)記找到結(jié)果
n = n + 1 ’
累加找到結(jié)果的個(gè)數(shù)
Exit
For
’找到結(jié)果后就可以退出文件格式循環(huán)
End If
Next
If b = False Then k = k + 1 ’
如果沒找到圖片累加個(gè)數(shù)
End
If
Next
MsgBox
"共處理成功"
& n &
"個(gè)圖片，另有"
& k &
"個(gè)非空單元格未找到對(duì)應(yīng)的圖片。"
Application.ScreenUpdating = True
End
Sub
小貼士▼
3） 代碼中使用了intersect語句交叉選取已使用的單元格區(qū)域。
Set
rngData =
Intersect
(rngData.Parent.UsedRange, rngData)
用戶可以選擇整列（比如整個(gè)A列）或多列單元格區(qū)域運(yùn)行代碼，而不用擔(dān)心因?yàn)檫\(yùn)算量過大，造成程序假死的情況。
4） 代碼導(dǎo)入的圖片格式支持五種常見的類型
".jpg"
,
".jpeg"
,
".bmp"
,
".png"
,
".gif"
.Shape.Height = 150
’圖形的高度，可以根據(jù)需要自己調(diào)整
.Shape.Width = 150 ’
圖形的寬度，可以根據(jù)需要自己調(diào)整