Приветствую всех гуру мира Excel и VBA. Излагаю свою задачу.
Имеется: 1. много файлов (jpg-фото сотрудников) с маской "аб1-иванов.jpg" (аб2 - номер отдела) 2. Два столбца в excel: первый столбец - "аб1-иванов.jpg"; второй столбец - "Иванов Иван Иваныч". То есть задано соответствие "имя файла" - "ФИО сотрудника"
Необходимо собственно переименовать все файлы на ФИО.jpg
Пробовал через TotalCommander, но там немного по другому реализовано переименование по списку, а тут нужно искать совпадение и сопоставлять найденному имени значение из соседней ячейки, TC не умеет искать, а excel, я уверен, умеет. Только с vba я не очень дружу. Прошу помощи набросать какой-нибудь пример.
Набор файлов:Ссылка удалена! (извиняюсь ) [moder]Нарушение п3 Правил форума.[/moder]
Приветствую всех гуру мира Excel и VBA. Излагаю свою задачу.
Имеется: 1. много файлов (jpg-фото сотрудников) с маской "аб1-иванов.jpg" (аб2 - номер отдела) 2. Два столбца в excel: первый столбец - "аб1-иванов.jpg"; второй столбец - "Иванов Иван Иваныч". То есть задано соответствие "имя файла" - "ФИО сотрудника"
Необходимо собственно переименовать все файлы на ФИО.jpg
Пробовал через TotalCommander, но там немного по другому реализовано переименование по списку, а тут нужно искать совпадение и сопоставлять найденному имени значение из соседней ячейки, TC не умеет искать, а excel, я уверен, умеет. Только с vba я не очень дружу. Прошу помощи набросать какой-нибудь пример.
Набор файлов:Ссылка удалена! (извиняюсь ) [moder]Нарушение п3 Правил форума.[/moder]yuriknsk
Sub ПереименоватьГруппуФайлов() Dim OldName As String, NewName As String, sPath As String Dim i As Long, lLastRow As Long sPath = "C:\Documents and Settings\Родители\Рабочий стол\Базы\Disks\Дизайны\K&K\kik\" lLastRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lLastRow OldName = sPath & Cells(i, 1) & ".GIF" 'старое имя в ячейке NewName = sPath & Cells(i, 2) & ".GIF" 'новое имя Name OldName As NewName Next i End Sub
[/vba] я его зачем-то изуродовал... переделывая под Вас, хотя достаточно тут [vba]
Код
Sub ПереименоватьГруппуФайлов() Dim OldName As String, NewName As String, sPath As String Dim i As Long, lLastRow As Long sPath = ActiveWorkbook.path & "/" lLastRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lLastRow OldName = sPath & Cells(i, 1) 'старое имя в ячейке NewName = sPath & Cells(i, 2) & ".jpg" 'новое имя Name OldName As NewName Next i End Sub
Sub ПереименоватьГруппуФайлов() Dim OldName As String, NewName As String, sPath As String Dim i As Long, lLastRow As Long sPath = "C:\Documents and Settings\Родители\Рабочий стол\Базы\Disks\Дизайны\K&K\kik\" lLastRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lLastRow OldName = sPath & Cells(i, 1) & ".GIF" 'старое имя в ячейке NewName = sPath & Cells(i, 2) & ".GIF" 'новое имя Name OldName As NewName Next i End Sub
[/vba] я его зачем-то изуродовал... переделывая под Вас, хотя достаточно тут [vba]
Код
Sub ПереименоватьГруппуФайлов() Dim OldName As String, NewName As String, sPath As String Dim i As Long, lLastRow As Long sPath = ActiveWorkbook.path & "/" lLastRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lLastRow OldName = sPath & Cells(i, 1) 'старое имя в ячейке NewName = sPath & Cells(i, 2) & ".jpg" 'новое имя Name OldName As NewName Next i End Sub
хм... работает только в случае полного совпадения количества фотографий и количества строк в excel, иначе ошибка "file not found" это исправимо?
хм... работает только в случае полного совпадения количества фотографий и количества строк в excel, иначе ошибка "file not found" это исправимо? yuriknsk
Сообщение отредактировал yuriknsk - Вторник, 09.02.2016, 12:18
Sub filrename() Dim i&, i_n&, n& Dim t As Object Dim t1() As String Dim k$, p$ p = ActiveWorkbook.path Set t = CreateObject("Scripting.Dictionary") i_n = Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To i_n If Cells(i, 1) <> "" Then k = Cells(i, 1) End If If Not t.exists(k) Then n = n + 1 t.Add k, Cells(i, 2) ReDim Preserve t1(n) t1(n) = k End If Next i For i = 1 To n If Dir(p & "/" & t1(i)) <> "" Then Name p & "/" & t1(i) As p & "/" & t(t1(i)) & ".jpg" End If Next i End Sub
[/vba]
yuriknsk, попробуйте моего "квазимоду" [vba]
Код
Sub filrename() Dim i&, i_n&, n& Dim t As Object Dim t1() As String Dim k$, p$ p = ActiveWorkbook.path Set t = CreateObject("Scripting.Dictionary") i_n = Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To i_n If Cells(i, 1) <> "" Then k = Cells(i, 1) End If If Not t.exists(k) Then n = n + 1 t.Add k, Cells(i, 2) ReDim Preserve t1(n) t1(n) = k End If Next i For i = 1 To n If Dir(p & "/" & t1(i)) <> "" Then Name p & "/" & t1(i) As p & "/" & t(t1(i)) & ".jpg" End If Next i End Sub
чет фигня какая-то, все вроде работает, сохраняю книгу sample.xltm потом открываю её, а она называется sample1 и при закрытии предлагает сохранить, как будто книга не сохранена... Ничего не понимаю
чет фигня какая-то, все вроде работает, сохраняю книгу sample.xltm потом открываю её, а она называется sample1 и при закрытии предлагает сохранить, как будто книга не сохранена... Ничего не понимаю yuriknsk
yuriknsk, не думаю, что это связано с макросом... расширение должно быть .xls или .xlsm а книгу пытается сохранить, потому что, книга sample1 у вас действительно не сохранена, он (ексель) её копирует почему-то... если у Вас проблема не решится, надо создать отдельную тему для решения данного вопроса.
yuriknsk, не думаю, что это связано с макросом... расширение должно быть .xls или .xlsm а книгу пытается сохранить, потому что, книга sample1 у вас действительно не сохранена, он (ексель) её копирует почему-то... если у Вас проблема не решится, надо создать отдельную тему для решения данного вопроса.Roman777