Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Как сохранить документ по имени ячейки в зависимости от названия файла
 
#1
22.02.2011 09:12:23
Доброе утро, уважаемое сообщество!  
 
Есть следующий код:  
 
 
   ThisFile = ActiveSheet.Name & ".xls" ' сохранение в хлс формат  
   iPath = ActiveWorkbook.Path  
   Filename = iPath  & "\" & ThisFile  
      ActiveWorkbook.SaveAs Filename, FileFormat:= _  
   xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _  
   , CreateBackup:=False  
 
как видно, идет сохранение файла в *.xls с текущим именем листа и в текущем расположении.  
Необходимо сделать так, чтобы имя файла было значением в ячейке, но сложность в том, что есть несколько имен файлов в зависимости от которых, нужно выбрать из какой именно ячейки брать для него имя.  
 
Например, есть два типа названий 12345-1212-NUMA-123123123123 и 12345-112-ISUE-12312312312311, т.е. если в названии содержится выражение NUMA, то сохранить нужно по имени ячейки A2, если ISUE, тогда по B2. Цифры все время разные, но выражения NUMA и ISUE  присутствуют во всех файлах. Либо же можно сохранить с той частью имени, которая идет после NUMA (это значение как раз и находится в А2) и ISUE (это значение в В2), т.е. есть имя 12345-1212-NUMA-123123123123, нужно сохранить как 123123123123. Такое вообще возможно?
 
 
 
#2
22.02.2011 09:34:15
Попробуйте оператор like, например:  
 
If ИмяФайла like "*NUMA*" then    
ИмяФайла = А2.Value  
else  
ИмяФайла = B2.Value  
End If
Редко но метко ...
 
 
 
#3
22.02.2011 12:39:13
Подскажите, как это добавить в мой код.  
 
У меня получилось так:  
 
ThisFile = ActiveSheet.Name & ".xls" ' сохранение в хлс формат  
If ActiveSheet.Name Like "*NUMA*" Then  
ActiveSheet.Name = А2.Value  
Else  
ActiveSheet.Name = B2.Value  
End If  
 
iPath = ActiveWorkbook.Path  
Filename = iPath & "\" & ThisFile  
ActiveWorkbook.SaveAs Filename, FileFormat:= _  
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _  
, CreateBackup:=False  
 
При исполнении выдает "Object required"
 
 
 
#4
22.02.2011 14:33:27
Наверное так:  
 
ThisFile = ""  
If ActiveSheet.Name Like "*NUMA*" Then  
ThisFile = А2.Value  
Else  
ThisFile = B2.Value  
End If  
 
ThisFile = ThisFile & ".xls" ' сохранение в хлс формат  
 
 
iPath = ActiveWorkbook.Path  
Filename = iPath & "\" & ThisFile  
ActiveWorkbook.SaveAs Filename, FileFormat:= _  
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _  
, CreateBackup:=False
Редко но метко ...
 
 
 
#5
23.02.2011 11:35:52
Блин, и в этом варианте выдает "Object required".  
Блин, так в чем же беда-то?
 
 
 
#6
23.02.2011 11:44:38
Даже не знаю в чем проблема, у меня работает, проверьте значения Ячеек А2 И В2, может там есть недопустимые знаки, и поетому не сохраняет.
Редко но метко ...
 
 
 
#7
23.02.2011 12:03:46
Вот мой файлик, может глянете что не так.
 
 
 
#8
23.02.2011 12:15:18
{quote}{login=Bishop}{date=23.02.2011 12:03}{thema=}{post}Вот мой файлик, может глянете что не так.{/post}{/quote}  
 
давайте файлик с реальными названиями листов, и значениями А2, В2
Редко но метко ...
 
 
 
#9
23.02.2011 12:45:29
вот только убрал ненужные поля, оставил только значения
 
 
 
#10
23.02.2011 12:53:55
Почему-то файлик не прикрипился
 
 
 
#11
23.02.2011 14:34:49
Добавил проверку на наличие пути для сохранения по умолчанию (если файл не был сохранен ранее).  
 
Sub test()  
Dim ThisFile$, iPath$, Filename$  
ThisFile = ""  
With ActiveSheet  
   If .Name Like "*NUMA*" Then  
       ThisFile = Str(.Range("A2").Value)  
   Else  
       ThisFile = Str(.Range("B2").Value)  
   End If  
End With  
 
ThisFile = ThisFile & ".xls" ' сохранение в хлс формат  
iPath = ActiveWorkbook.Path  
 
If iPath = "" Then  
   iPath = " ТУТ ВСТАВИТЬ ПУТЬ К ПАПКЕ ДЛЯ СОХРАНЕНИЯ" ' сюда вставьте путь для сохранения по умолчанию  
End If  
Filename = iPath & "\" & ThisFile  
ActiveWorkbook.SaveAs Filename, FileFormat:= _  
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _  
, CreateBackup:=False  
 
MsgBox "Файл сохранен: " & Filename  
 
End Sub
Редко но метко ...
 
 
 
#12
23.02.2011 18:17:02
Спасибо, работает!
 
 
 
Страницы: 1
Читают тему
Наверх