图片文件名的前后批量加字

过客fppt

用WPS的WordVBA参与一下！


完整函数如下图所示

过客fppt

过客fppt 发表于 2023-10-20 19:42
用WPS的WordVBA参与一下！

1. <blockquote>Sub 重命名图片V2()

复制代码

过客fppt

过客fppt 发表于 2023-10-20 19:42
用WPS的WordVBA参与一下！

1. Sub 重命名图片V2()
   
2. 
   
3.     Dim folderPath As String
   
4.     Dim file As String
   
5.     Dim Name0, Name1 As String
   
6.     Dim dialog As FileDialog
   
7.     Dim n
   
8.    
   
9.     Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
   
10.    
    
11.     ' 打开文件夹选择对话框
    
12.     With dialog
    
13.         .Title = "选择文件夹"
    
14.         .AllowMultiSelect = False
    
15.         If .Show <> -1 Then
    
16.             MsgBox "未选择文件夹！"
    
17.             Exit Sub
    
18.         Else
    
19.             folderPath = .SelectedItems(1)
    
20.         End If
    
21.     End With
    
22.    
    
23.     ' 获取名称前缀后缀
    
24.     Name0 = "第"
    
25.     Name1 = "题图"
    
26.    
    
27.     ' 遍历文件夹中的所有文件
    
28.     file = Dir(folderPath & "\*.*")
    
29.     Do While file <> ""
    
30.         ' 如果是图片文件，则进行重命名
    
31.         If InStr(1, LCase(file), ".jpg") > 0 Or InStr(1, LCase(file), ".jpeg") > 0 Or InStr(1, LCase(file), ".png") > 0 Or InStr(1, LCase(file), ".gif") > 0 Or InStr(1, LCase(file), ".bmp") > 0 Then
    
32.             n = SplitString(file, ".")
    
33.             Name folderPath & "" & file As folderPath & "" & Name0 & n(0) & Name1 & "." & n(1)
    
34.         End If
    
35.         file = Dir
    
36.     Loop
    
37.    
    
38.     MsgBox "图片重命名完成！"
    
39. End Sub
    
40. 
    
41. Function SplitString(str, fen)
    
42.     Dim arr() As String
    
43. 
    
44.     arr = Split(str, fen)
    
45. 
    
46.     If UBound(arr) > 0 Then
    
47.         SplitString = Array(arr(0), arr(1))
    
48.     Else
    
49.         SplitString = Array("", "")
    
50.     End If
    
51. End Function
    

复制代码

过客fppt

过客fppt 发表于 2023-10-20 19:44

不知道为什么我粘贴代码进来回复后总是只有一行代码？
另外一个应该是完整代码的回复，正在审核中！

相见是缘8

过客fppt 发表于 2023-10-20 19:45

过客fppt老师好！

感谢援手！在我这运行不了，请看图。

zpy2

相见是缘8 发表于 2023-10-20 18:19
zpy2老师好！
http://e.anyoupin.cn/Edata/?p=tools.ceshi.index/downloadTreeFile&file=/excel/rgRenam ...

一般杀毒软件都是这样子的，二进制文件都报。

zpy2

相见是缘8 发表于 2023-10-20 18:12
zpy2 老师好！
是，我用的是公司的电脑，32位 XP系统，office 是 2003 版的，因电脑捆绑定了公司的仓储 ...

牛。。。
仓储软件不能升级一下。。。

zpy2

zpy2 发表于 2023-10-21 08:10
一般杀毒软件都是这样子的，二进制文件都报。

这个是go源码，有兴趣可以自己编译一下

zpy2

相见是缘8 发表于 2023-10-19 18:54
zpy2老师好！感谢老师援手，唉这个烂电脑，软件下载后运行不了，提示如下图：

这个DocxPage应该是52上，批量获取docx页数的吧

相见是缘8

zpy2 发表于 2023-10-21 08:10
一般杀毒软件都是这样子的，二进制文件都报。

zpy2 老师好！
哦！是这样呀！