如何自动重命名照片

janking

1、我有每个学生姓名命名的照片文件 比如 张三.jpg
2、我有每个学生的姓名 班级 和学号 表格
3、要求自动命名每个学生的照片文件 格式为 1班1号张三.jpg  (每个学生有自己的学号）

janking

ecel.zip (861.03 KB, 下载次数: 17)

2022-9-13 12:01 上传

点击文件名下载附件

3190496160

Sub 重命名()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
lj = ThisWorkbook.Path & "\一（1） - 副本\"
With Sheets("人员管理列表")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:b" & r)
End With
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        zf = Trim(ar(i, 1)) & ".JPG"
        d(zf) = i
    End If
Next i
f = Dir(lj & "*.jpg")
Do While f <> ""
    xh = d(f)
    mc = Split(f, ".")(0)
    If xh <> "" Then
        Name lj & f As lj & ar(xh, 2) & mc & ".jpg"
    End If
f = Dir
Loop
MsgBox "ok!"
End Sub

3190496160

ecel.rar (870.95 KB, 下载次数: 17)

2022-9-13 15:40 上传

点击文件名下载附件

xiangbaoan

1. Sub test1()
   
2.   Dim sPath As String
   
3.   With Application.FileDialog(msoFileDialogFolderPicker)
   
4.     .InitialFileName = ThisWorkbook.Path
   
5.     If .Show Then sPath = .SelectedItems(1) Else Exit Sub
   
6.   End With
   
7.   If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
   
8.   Dim ar, i As Long, sExt As String, sGrade As String, sSrc As String, sDst As String
   
9.   sExt = ".jpg"
   
10.   sGrade = Val(Split(ThisWorkbook.Name, "（")(1)) & "班"
    
11.   ar = Range("A1").CurrentRegion
    
12.   For i = 2 To UBound(ar)
    
13.     sSrc = sPath & ar(i, 1) & sExt
    
14.     sDst = sPath & sGrade & Val(Right(ar(i, 2), 3)) & "号" & ar(i, 1) & sExt
    
15.     If Len(Dir(sSrc)) Then
    
16.       If Len(Dir(sDst)) Then Kill sDst
    
17.       Name sSrc As sDst
    
18.     End If
    
19.   Next
    
20.   Beep
    
21. End Sub

复制代码

limonet

关键字：HashTable

limonet

Sub limonet()
    Dim i%, H$
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        H = H & ";" & Cells(i, "A") & "=" & Cells(i, "B")
    Next i
    CreateObject("wscript.shell").Run "powershell push-location " & ThisWorkbook.Path _
    & "\一（1）;$h=@{" & Mid(H, 2) & "};Dir | % {Ren $_ -NewName ('1班'+$h[$_.basename]+'号'+$_.name)}", 0
End Sub

ykcbf1100

练个手，图片文件批量重命名

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.6.5
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     Set ws = ThisWorkbook
   
7.     p = ws.Path & ""
   
8.     p1 = p & "一（1） - 副本"
   
9.     fn1 = Split(ws.Name, ".")(0) & "班"
   
10.     Set sh = ws.Sheets("人员管理列表")
    
11.     With sh
    
12.         r = .Cells(Rows.Count, 1).End(3).Row
    
13.         arr = .[a1].Resize(r, 2)
    
14.     End With
    
15.     For i = 2 To UBound(arr)
    
16.         s = arr(i, 1)
    
17.         d(s) = Right(arr(i, 2), 3)
    
18.     Next
    
19.     For Each f In fso.GetFolder(p1).Files
    
20.         fn = fso.GetBaseName(f)
    
21.         If d.exists(fn) Then
    
22.             f.Name = fn1 & d(fn) & "号" & fn & "." & fso.GetExtensionName(f)
    
23.         Else
    
24.             f.Name = fn1 & fn & "." & fso.GetExtensionName(f)
    
25.         End If
    
26.     Next f
    
27.     Set d = Nothing
    
28.     Application.ScreenUpdating = True
    
29.     Application.DisplayAlerts = True
    
30.     MsgBox "OK！"
    
31. End Sub
    
32. 
    

复制代码