Переименовать папку и файл

[valerij]

Сообщение от КаМММ

Ну если положить файл на рабочий стол.

1. Все работает, НО, есть минус, макрос сохраняет два файла, новый и старый, старый не нужен, может макросом, мона как то его удалять?
2. А как быть с путем к файлу, ну не занимать же весь Рабочий стол папками месяцев, я на р. стол вывожу только ярлык и каждый месяц его меняю

[SAS888]

Посмотрите один из возможных вариантов решения.
При каждом открытии-закрытии книги, имя родительской папки файла станет таким же (если они не совпадали) как имя файла, и на рабочем столе будет создан (или заменен) соответствующий ярлык.
Обратите внимание, что после переименования файла вручную, необходимо хотя бы открыть и закрыть файл.
Для решения задачи таким способом во-первых, используется ячейка листа (в примере это "IV65536") для хранения имени файла до переименования, чтобы определить путь к уже существующему ярлыку, во-вторых, используется папка для временного хранения файла (в примере это папка документов пользователя) в момент переименования родительской папки.
Если устроит, то Ваш макрос очистки нужно будет запускать только после определения факта переименования файла, опять же используя ячейку, хранящую предыдущее имя файла.

[valerij]

Сообщение от SAS888

Посмотрите один из возможных вариантов решения.

SAS!
К сожалению, нет времени, вечером разберусь, отпишусь, надеюсь в субботу загляните.
КаМММ!
А Ваш макрос, можно изменить с учетом моих пожеланий?

[valerij]

SAS!
Да, работает, немножко не удобно, что сам файл нужно переименовывать, а не папку, ну с этим можно смирится, в принципе, какая разница, что переименовывать!!
НО, не получается, у меня, вставить Ваш код в мой, ошибка выскакивает.

[valerij]

КаМММ!
В Вашем макросе добавил в строке:
If ActiveWorkbook.Name <> Имя & ".xls" Then ActiveWorkbook.SaveAs Filename:=Путь _
& Application.PathSeparator & Имя & ".xls": Kill Путь & Application.PathSeparator & ИмяСтар: Run "Очистка"
Теперь, старый файл, удаляется, очищается, все ОК.
(Не знаю, правильно, не правильно??)

[КаМММ]

Да всё правильно
Был уверен что это вы можете сами дорисовать по тому и не стал сначала заморачиватся.
А вот проверка соответствия названия папки - месяцу

ввв:
 Select Case Имя
        Case "Январь"
        GoTo ссс
        Case "Февраль"
         GoTo ссс
        Case "Март"
         GoTo ссс
        Case "Апрель"
         GoTo ссс
        Case "Май"
         GoTo ссс
        Case "Июнь"
         GoTo ссс
        Case "Июль"
         GoTo ссс
        Case "Август"
         GoTo ссс
        Case "Сентябрь"
         GoTo ссс
        Case "Октябрь"
         GoTo ссс
        Case "Ноябрь"
         GoTo ссс
        Case "Декабрь"
Case Else:
 MsgBox "Название каталога не есть месяц"
 Exit Sub
End Select
ссс:
If ActiveWorkbook.Name <> Имя & ".xls" Then......

Уверен что всё это можно сделать и с меньшим количеством строчек, но это первое что пришло в голову
Извиняюсь что в выходные не ответил. (некогда было)

[SAS888]

не удобно, что сам файл нужно переименовывать, а не папку

Можно сделать и так. Только какая разница? Пока файл не открыть (закрыть), имена файла и папки не сравняются.

не получается, у меня, вставить Ваш код в мой, ошибка выскакивает.

А что Вы от меня хотите?

[valerij]

Сообщение от SAS888

А что Вы от меня хотите?

SAS
Что бы Вы "вставили", ведь так классно все делает....
Как связать мой и Ваш Private Sub Workbook_Open()???
Куда, Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) вставить? У меня же есть Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range), а вместе они ошибку выдают.

[КаМММ]

SAS
Что бы Вы "вставили", ведь так классно все делает....
Как связать мой и Ваш....

Чтобы связать надо слегка его макрос "раздербанить"
(Кстати мне всегда нравились его решения по крайней мере я для себя всегда в них чего-нибудь находил полезное)
В данном случае у меня осталось следующее:

Private Sub Workbook_Open()
Путь = ThisWorkbook.Path
ИмяСтар = ThisWorkbook.Name
For S = Len(Путь) To 1 Step -1 ' Цикл отсчета с конца
If Mid(Путь, S, 1) = Application.PathSeparator Then GoTo ввв ' Проверяет значек разделитель
ммм = Mid(Путь, S, 1) & ммм ' Добавляет по значку
Имя = ммм
Next S
ввв:
If ActiveWorkbook.Name = Имя & ".xls" Then Exit Sub
 Select Case Имя
        Case "Январь"
        GoTo ссс
        Case "Февраль"
         GoTo ссс
        Case "Март"
         GoTo ссс
        Case "Апрель"
         GoTo ссс
        Case "Май"
         GoTo ссс
        Case "Июнь"
         GoTo ссс
        Case "Июль"
         GoTo ссс
        Case "Август"
         GoTo ссс
        Case "Сентябрь"
         GoTo ссс
        Case "Октябрь"
         GoTo ссс
        Case "Ноябрь"
         GoTo ссс
        Case "Декабрь"
Case Else:
 MsgBox "Название каталога не есть месяц"
 Exit Sub
End Select
ссс:
ActiveWorkbook.SaveAs Filename:=Путь & Application.PathSeparator & Имя & ".xls"
Kill Путь & Application.PathSeparator & ИмяСтар
Call Очистка
    MyPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    Set WSHShell = CreateObject("WScript.Shell")
    strDesktop = WSHShell.SpecialFolders("Desktop")
    Set objShortCut = WSHShell.CreateShortcut(strDesktop & "\" & Имя & ".lnk")
        objShortCut.TargetPath = MyPath
        objShortCut.IconLocation = "Moricons.dll, 40"
        objShortCut.Save
MsgBox "Название обновлено"
End Sub

Переменные как обычно не объявил (такая у меня дурацкая привычка)
ЗЫ SAS прошу прощения за плагтат. (тем более такой некорректный)

[valerij]

Сообщение от КаМММ

 Select Case Имя
        Case "Январь"
        GoTo ссс
        Case "Февраль"
         GoTo ссс
        Case "Март"
         GoTo ссс
        Case "Апрель"
         GoTo ссс
        Case "Май"
         GoTo ссс
        Case "Июнь"
         GoTo ссс
        Case "Июль"
         GoTo ссс
        Case "Август"
         GoTo ссс
        Case "Сентябрь"
         GoTo ссс
        Case "Октябрь"
         GoTo ссс
        Case "Ноябрь"
         GoTo ссс
        Case "Декабрь"

КаМММ!
А зачем нужно это, у меня и без этого все ОК!