Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Заменить наименование файла на содержимое ячейки
 
#1
15.01.2014 16:23:49
Добрый день!
Очень прошу о помощи!
Есть макрос, который всем хорош, но работает только отдельном в открытом файле, но очень  нужна пакетная обработка, т.к. файлов очень много. Может кто знает как это сделать?



Код
Sub Копия_2()

 Sheets(Array("Отчет").Se
lect
 Sheets("Отчет".Activate
 ActiveWorkbook.SaveAs Filename:= _
 "C:\test\result\" & Cells(11, .Value & ".xls", FileFormat:= _
 xlNormal, CreateBackup:=False
 ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
 Sheets("Отчет".Select
 Range("A1".Select
 Sheets("Отчет".Select
 Range("A1".Select

End Sub
Изменено: Svetim - 16.01.2014 00:57:01
 
 
 
#2
15.01.2014 16:48:48
Без примера плохо понимаю. Да и некоторые строки вообще непонятно зачем здесь нужны. Мне лично не ясно, зачем несколько раз выделять то лист, то ячейку "А1". Видимо писали рекодером. Ну да хозяин-барин.  Если правильно понял, берется значение из ячейки "Н11" и сохраняется файл с таким именем.
Тогда можно так. Записывайте все названия в ячейки от "H11" и ниже. Затем пробуйте так:

Код
Sub Копия_2()
Dim sht1 As Worksheet
Dim My_name As String

Sheets(Array("Отчет")).Select

Sheets("Отчет").Activate

Set sht1 = ThisWorkbook.Worksheets("Отчет")
i = 11
Do While sht1.Cells(i, 11) <> ""
    My_name = sht1.Cells(i, 11)
    ActiveWorkbook.SaveAs Filename:= _
    "C:\test\result\" & My_name & ".xls", FileFormat:= _
    xlNormal, CreateBackup:=False
    ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
    Sheets("Отчет").Select
    Range("A1").Select
    Sheets("Отчет").Select
    Range("A1").Select
    i = i + 1
Loop
End Sub
Когда испробованы все варианты, я начинаю плясать с бубном. Как правило — помогает.
 
 
 
#3
15.01.2014 19:01:51
К сожалению не работает... или я неправильно поняла.
И еще каким образом этот макрос может поменять имена нескольких файлов?   Я не сильна в макросах, но тут вроде обращение к текущей книге?
 
 
 
#4
15.01.2014 19:10:04
Попробуйте объяснить задачу как-то иначе.
Как я понял сейчас - Вам нужно наделать кучу копий файлов, изменив их имя на значение Cells(11,  8)  непонятно какого файла. Вероятно того же, который копируем.
Тогда вероятно этот код должен быть в другом файле, этим кодом перебираем файлы, каждый открываем, читаем Cells(11,  8) , далее сохраняем его под другим именем и закрываем.
Я бы вероятно читал с помощью getobject(), запоминал значение Cells(11,  8) , затем закрывал, затем делал копию или переименовывал.
 
 
 
#5
16.01.2014 02:17:49
Файлы - это отчеты сотрудников. В ячейке Н11 их ФИО.  И копировать их не нужно. Открывать каждый файл, чтобы переименовать нереально. Я уже писала, что мой макрос работает, но для каждого файла отдельно, а мне нужно для группы. Например для всех файлов в папке test. Надеюсь понятно объяснила... :(
 
 
 
#6
16.01.2014 02:36:14
Я тоже не понял...
Цитата
И копировать их не нужно.
Как же? Ведь в Вашем макросе файл сохраняется с новым именем, а это и есть копия.
 
 
 
#7
16.01.2014 10:06:37
Разместить новую книгу с Sub wwww() в папке с файлами подлежащими переименованию.
Создать в этой папке папку "Test_1" для складирования в неё переименованных файлов.
Без проверок: на форматы, наличие записей в ячейке "H11" (в т.ч. допустимых для имён), обновления связей.

Код
Sub wwww()
'Application.ScreenUpdating = False
With ThisWorkbook
путь$ = .Path
файл$ = Dir(путь$ & "\*.xls")
Do While файл$ <> ""  'пока есть файлы
  If файл$ <> .Name Then 'кроме этого файла
  Workbooks.Open Filename:=путь$ & "\" & файл$
  With ActiveWorkbook
  .SaveAs Filename:= _
  ThisWorkbook.Path & "\" & "Test_1" & "\" & _
  .Sheets(1).Cells(11, 8) & ".xls", FileFormat:=xlNormal
  .Close SaveChanges:=True
  End With
'  Kill путь$ & "\" & файл$ 'убить старые файлы
  End If
файл$ = Dir
Loop
End With
Beep
'Application.ScreenUpdating = True
End Sub
Изменено: k61 - 16.01.2014 10:07:37
 
 
 
#8
16.01.2014 10:08:20
"копировать их не нужно" - ActiveWorkbook.SaveAs делает как раз копию файла, если он уже сохранён.
"Открывать каждый файл ... нереально" - иначе Вы не прочитаете Cells(i, 11). Тогда давайте готовьте список - какой файл как переименовывать.

И чего же "открывать нереально" - кодом вполне реально. Пока я писал этот текст - можно было бы уже пару сотен файлов обработать...
 
 
 
#9
16.01.2014 12:10:03
Советую почитать:
Как средствами VBA переименовать/переместить/скопировать файл
Просмотреть все файлы в папке
Код
Sub Rename_Files()
 Dim sFolder As String, sFiles As String, sFileName As String, sNewFileName As String

 With Application.FileDialog(msoFileDialogFolderPicker)
 If .Show = False Then Exit Sub
 sFolder = .SelectedItems(1)
 End With
 sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
 Application.ScreenUpdating = False
 sFiles = Dir(sFolder & "*.xls*")
 Do While sFiles <> ""
 Workbooks.Open sFolder & sFiles
 sFileName = sFolder & sFiles
 sNewFileName = sFolder & Sheets("Отчет").Range("H11").Value & ".xls"
 ActiveWorkbook.Close True
 sFiles = Dir
 Name sFileName As sNewFileName
 Loop
 Application.ScreenUpdating = True
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#10
17.01.2014 17:31:19
Большое спасибо за отклик! Буду пробовать!
 
 
 
Страницы: 1
Читают тему
Наверх