Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос сохранения книги. Перехват ошибки при отказе от перезаписи
 
#1
30.11.2018 20:07:59
Здравствуйте, уважаемые эксперты!
Понимаю, что вопросов о сохранения книги с помощью макроса великое множество, но найти именно то, с чем у меня проблема - не получилось. Поэтому надеюсь на вашу помощь.
Собственно вот макрос, который я составил:
Код
Sub Сохранение()

    Папка = "D:\" & Range("A1")
    Подпапка = Range("A2")
    Путь = Папка & "\" & Подпапка
    Название = Range("A3")
    ИмяФайла = Путь & "\" & Название
    
    If Dir(Папка, vbDirectory) = "" Then
        MkDir (Папка)
        ChDir (Папка)
        Else: ChDir (Папка)
    End If
    
    If Dir(Путь, vbDirectory) = "" Then
        MkDir (Путь)
        ChDir (Путь)
        Else: ChDir (Путь)
    End If
    
    ActiveWorkbook.SaveAs (ИмяФайла)

End Sub
Меня почти полностью устраивает, как он работает, если бы не одно но:
Когда я сохраняю файл под уже существующем именем, то Excel меня вполне справедливо спрашивает, хочу ли я перезаписать файл.
Если я отвечаю "НЕТ", то появляется ошибка:

Мне бы хотелось, чтобы если я ответил "НЕТ", то ошибка бы не вылезала.

Можно в принципе написать вначале On erroe resume next, но что-то мне подсказывает, что это не лучший вариант.
Может есть способ предотвратить именно эту ошибку? Или как-то завершить макрос при ответе "НЕТ"?
Изменено: Valo - 30.11.2018 20:10:43
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
 
 
#2
30.11.2018 20:16:54
Сделайте проверку на существование идентичной книги и если такова уже есть, то выводите сообщение, а уже исходя из  ответа на Ваше сообщение, программа должна совершить сохранение либо закончить свое выполнение.
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#3
30.11.2018 20:18:04
чтобы не возникало ошибки нужно знать что делать с файлами:
1. с тем что УЖЕ ЕСТЬ с этим именем?
2. с тем, что Вы решили сохранить с уже существующим именем?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#4
30.11.2018 20:32:13
Valo,
Вам задан простой вопрос: Что делать?
забудьте о программировании, макросох, о способе определения, что такой уже есть, простыми словами ЧТО делать в этой ситуации
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#5
30.11.2018 20:35:44
Nordheim, Ігор Гончаренко, если я отвечаю "НЕТ", то просто продолжаю работу с документом.
Изменено: Valo - 30.11.2018 20:39:28
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
 
 
#6
30.11.2018 20:44:43
отлично.. продолжайте
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#7
30.11.2018 20:47:43
Попробуйте так , не проверял, но смысл должен быть понятен.

 
Код
    Sub Сохранение()
    Dim fname$
    
    Application.DisplayAlerts = False
    Папка = "D:\" & Range("A1")
    Подпапка = Range("A2")
    Путь = Папка & "\" & Подпапка
    Название = Range("A3")
    ИмяФайла = Путь & "\" & Название
    
    If Dir(Папка, vbDirectory) = "" Then
        MkDir (Папка)
        ChDir (Папка)
        Else: ChDir (Папка)
    End If
    
    If Dir(Путь, vbDirectory) = "" Then
        MkDir (Путь)
        ChDir (Путь)
        Else: ChDir (Путь)
    End If
    fname = Dir(ИмяФайла & "*.xls*")
    If fname <> "" Then
        If MsgBox("Файл существует." & vbNewLine & "Хотите заменить?", vbYesNo) = vbNo Then Application.DisplayAlerts = True: Exit Sub
    End If
    ActiveWorkbook.SaveAs (ИмяФайла)
    Application.DisplayAlerts = True
End Sub
Изменено: Nordheim - 30.11.2018 20:51:31
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#8
30.11.2018 20:58:26
Nordheim, огромное спасибо! Смысл я понял. Отключаем DisplayAlerts, чтобы проверить наличие файла именно с помощью VBA.
Только зачем переменная fname, если и без нее работает?
Код
Sub Сохранение()

    Application.DisplayAlerts = False
    Папка = "D:\" & Range("A1")
    Подпапка = Range("A2")
    Путь = Папка & "\" & Подпапка
    Название = Range("A3")
    ИмяФайла = Путь & "\" & Название
    
    If Dir(Папка, vbDirectory) = "" Then
        MkDir (Папка)
        ChDir (Папка)
        Else: ChDir (Папка)
    End If
    
    If Dir(Путь, vbDirectory) = "" Then
        MkDir (Путь)
        ChDir (Путь)
        Else: ChDir (Путь)
    End If
    
    If ИмяФайла <> "" Then
        If MsgBox("Файл существует." & vbNewLine & "Хотите заменить?", vbYesNo) = vbNo Then Application.DisplayAlerts = True: Exit Sub
    End If
    
    ActiveWorkbook.SaveAs (ИмяФайла)
    Application.DisplayAlerts = True

End Sub
Изменено: Valo - 30.11.2018 20:58:52
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
 
 
#9
30.11.2018 21:01:44
ИмяФайла - это всегда есть и обработчик If ... Then не нужен, а в переменную fname записывается уже существующий файл, поэтому в Вашем случае всегда будет сообщение, в моем только при наличии такого же файла. Как то так.
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#10
30.11.2018 21:06:36
Nordheim, понял. Еще раз большое спасибо!
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
 
 
 
Страницы: 1
Наверх