VBA在Excel工作表内提取并批量修改图片名称

VBA在Excel工作表内提取并批量修改图片名称

工作中你是否遇到过根据需要修改图片名称的问题？图片数量

少时可以点击鼠标右键--重命名，数量多且要求不严格时可以批量

选中-一右键一-重命名。如果修改的图片名称要求精确，比如图片名

称为“张三”、“李四”等需要修改为“一班张三”、“二班李四”

等，该如何处理呢？以上两种方法都无法快速解决。

VBA代码中，有一种方法可以修改图片名称：Name"oldName"

As"NewName”的方法。“oldName”为全路径下图片名称，“NewName”

为全路径下图片名称(即修改后的图片路径和名称，若修改前后路径

相同，直接将原图片名称修改；若修改前后路径不同，相当于图片剪

贴到新路径后内再重新修改名称)。

操作思路：

先提取指定文件夹内所有文件名称，符合图片格式的文件将名称

列举到Excel工作表“提取图片”的A列：在B列对应填入“重命名”

后的图片名称，利用V3A修改图片名称的方法(Name“oldName”As

“NewName"),对应修改图片名称。

示例：

文件夹内有不同格式的图片

VBA代码运行提取所有图片名称

EAB

11图片名称重命名

21.binp

310.bmp

411.tif

512.tif

613.jpg

714.gif

815.binp

916.jpg

10]17.bmp

1118.tif

122.tif

133.jpg

144.bmp

155.gif

166.gif

177.gif

188.JPg

19]9.bmp

填写需修改图片对应名称:

B

1图片名称重命名

21.bmp

310.bmp

411.tif

512.tif四

613.jpg五

14.gif六

15.binp七

16.jpgA

17.bmp九

18.tif

2.tif

3.jpg——

144.bmp

155.gif

166.gif

177.gif

188.jpg---H

199.binp

VBA代码运行批量修改图片名称

直接上代码:

SubReNamePictureName0

'CallPicName("提取图片"，1)

CallReNamePicC1提取图片"，1)

EndSub

FunctionPicName(SheetNAsString,RowNumbAsInteger)'获取路径下的图片名称

DimPictureNameAsString

RowNumb=1

DimpictureAAsString

DimPicArr0AsVariant

DimPicSpIi10AsString

ReDimPicArr(8)

PicArr=Array("jpg",'jpeg","png","gif","bmp'"tif","exif","apng")'列举图片后

假名称

OnErrorResumeNext

PictureName=Dir(Thisfllorkbook.Path&"\picname\*.*M)'提取文件夹下所有文件名称

SheetsC•提取图片").Cells(RowNumb,1)="图片名称”

DoWhilePictureName<>""

WithGetObject(ThisWorkbook.Path&"\picname\"&PictureName)

PicSplit=SpIit(PictureName,")‘以为界拆分数组

Fori=0ToUBcund(PicArr).不确定文件名称中是否有取最后一个数组为文

件格式后缀不会有错

IfPicArr(i)=PicSplit(UBound(PicSplit))Then'提取的文件名称后缀名符合需提

取的文件名称，即将提取后的文件名称放在指定单元格内

RowNumb=^owNumb+1

Sheets("提取图片").Cells(Rov/Numb,1)=PictureName

ExitFor

EndIf

Next

.CloseFaIse

EndWith

PictureName=Dir

Loop

EndFunction

FunctionReNamePic(SheetNAsString,RowNumbAsInteger)'修改图片名称

DimPictureNameAsString

DimRowsCountAsIntegsr

DimPicSpIit()AsString

DimNewNameAsString

OnErrorResumeNext

RowsCount=Sheets("提取图片").CelIs(Rows.Count,1).EndIUp).Row

Fori=2ToRowsCount

PictureName=Sheets("提取图片").CelIs(i,1).Value

PicSplit=Split(PictureName,")'以为界拆分数组

NewName=Sheets。'提取图片").CelIs(i,2).Value'提取•图片目标名称

NameThisWorkbook.Path&"\picname\"&PictureNameAsThisWorkbook.Path&"\picname\"

&NewName&"&PicSpIit(UBound(PicSpIit))'修改图片名称，图片后缀名不变。

Next

EndFunction

代码截图:

II

1)

hactig〃dl.0«UIMStr>u,52AiXau(«r)R财篇片W林

Dia1><«»•*«»•AsStriM

幺，・，3-：

Dia>i€t«r«AAiStriy

DiaFieArrOAsV«ri«ol

DiaFtcSplHOA，$lr>B<

KaDiaFicArr(B)

PicArr：・”•《・，•口二•丽一》.片融自蛤

0*Irrwrl«sw«M««t

••)y文件典下新育文件名称

TithaiSjxQ(nu,，,r”8k?«a■a?"tardli)

r«»•0ToMsH九Wr)，不好£件办2*^^•

IfFicArrG)=Pic£〃”CB,s，援】€521。)TU>Ub的文件的脸♦无格内

)miXTa.I)•九—《一

Uitv«

luiif

MQ

Clx・7«li«

U4fiU

P“v*r«y♦・=Dir

，­，♦・，―吃・■.J.“)・《・▼℃&lzrt>l»wkft*Tc.yl'&t7

DiaPI“B«V・・AsStrittf

Di*XsC・gQAsIfit«c«r

Di*Fa«$pl»t0At5mB<

Di*AxStxsnx

0*Err”!««*«M««t

R"2t：c«iiia»rtjs，i)nuGd与)*

FarI•2T«*“<£