Страницы: 1
RSS
При ошибке в макросе чтобы выскакивало окошко.
 
     Здравствуйте.
    Имеется код. Его задача вычесть из имени активного (открытого) файла цифру 1, тем самым получив имя предыдущего файла, открыть его, скопировтаь ячейку, закрыть его и вставить скопированное в определённую ячейку активного файла.
Вопрос:
    Если имя предыдущего файла (вычесть из имени активного (открытого) файла цифру 1, тем самым получив имя предыдущего файла) не найдено, макрос выводит сообщение, что файл с этим именем не найден (не дословно привёл). На нём можно нажать ОК. Если нажать - вылетишь в дебаггер. А как сделать так, чтобы если нажать ок в указанном сообщении - то макрос бы прекращал свою работу (т.е. просто не выполнялся бы).
Приложу файл, чтобы можно было запустить код и увидеть сообщение.
Изменено: Екселист - 19.06.2015 19:17:12
 
Навскидку
On Error Goto [Закладка]

а в закладке - обработка ошибки
select case err.number
case (номер нужной ошибки)
msgbox Err.Number & vbcrlf & Err.Description
exit sub
end select
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
В начале кода отключить сообщения об ошибках Excel
Код
Application.DisplayAlerts = False
Включить свой обработчик ошибок, например
Код
On Error GoTo MsgErr
где MsgErr Ваша подпрограмма обработки ошибок
Согласие есть продукт при полном непротивлении сторон
 
Михаил Лебедев,
Закладка - это другой макрос? Или как?
 
Цитата
Sanja написал: где MsgErr Ваша подпрограмма обработки ошибок
Как она должна выглядеть? Я просто не силён в ВБА
 
Цитата
Михаил Лебедев написал: case (номер нужной ошибки)
Где брать этот номер?
 
Код
..........
..........
'Вычитание из названия файла 1 (т.е. определение имени предыдущего файла).
    On Error Goto lbl1
    dtName = dtName - 1
    Name0 = Format(dtName, "yyyy/mm/dd")
.......
.......
    End With
lbl1:
select case err.number 
case (номер нужной ошибки) 
msgbox "Нужная ошибка " & Err.Number & vbcrlf & Err.Description 
case else
msgbox Err.Number & vbcrlf & Err.Description 
end select      
    Application.DisplayAlerts = True
End Sub  
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Код
.......
    End With
lbl1:
select case err.number 
Откуда здесь End With?
 
Код
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("C:\FSO\ScriptLog.txt") Then
 'open file or copy paste value cells
Else
 msgbox "File does not exist.?"
End If
Изменено: R Dmitry - 19.06.2015 19:30:51
Спасибо
 
Цитата
Екселист написал: Где брать этот номер?
Посмотрите кусок кода, который я привел. Это Ваш же код из Вашей же ссылки, я его только дописал немного. Сориентируетесь ,поди? :) Я специально оставил MsgBox в 2- х местах.
Допустим Вы поставите вместо (номер нужной ошибки) - любое число, например 1. Тогда все остальные ошибки отработаются в ветке case else. Msgbox Вам и выдаст тогда номер Вашей ошибки Err.Number и ее описание Err.Description
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Цитата
Екселист написал: Откуда здесь End With?
строка 48 в Вашем код.  
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Михаил Лебедев Понял.
Михаил Лебедев,  R Dmitry,
Большущее Вам спасибо.
Изменено: Екселист - 19.06.2015 19:41:02
 
Упс теперь при выполнении успешном макроса выскакивает окошко с цифрой 0 внутри. Как убрать?
 
Проверять: если не ноль, то выводить MsgBox.
 
Юрий М,
Не понял ответ. Мне не надо выводить. Мне надо убрать. Сейчас я  сделал, что при ненахождении файла выходит окно с ошибкой и всё. Но при успешной работе макроса выходит окно с цифрой 0. Как его убрать?
Изменено: Екселист - 19.06.2015 20:42:52
 
Цитата
Екселист написал: Мне не надо выводить
Цитата
Юрий М написал: если не ноль, то выводить MsgBox.
 
Код
case 0: exit sub
или поставить exit sub до обработчика ошибок. Как обычно и делают.
 
Hugo,
И макрос кончится. И к чему это? 0 мне не мешает. Он появился после того, как я обработал ошибку с отсутствием файла. Макрос отрабатывает исправно, но задалбывает нажимать ОК на окошке с 0. Его не надо останавливать. Надо чтобы просто макрос сам нажимал ОК или не выдавал окна.
 
Цитата
Михаил Лебедев написал:
On Error Goto [Закладка]
Не закладка, а строка. Ознакомьтесь
Цитата
Екселист написал:
Мне не надо выводить. Мне надо убрать.
И к чему это?
но задалбывает нажимать ОК
Его не надо
Надо чтобы

There is no knowledge that is not power
 
Мое предложение на Вашем коде
Код
Sub DateFiles1()
    Dim NameXLSM1 As String  'Имя открываемого файла с расширением
    Dim Name1 As String  'Имя открываемого файла без расширения
    Dim NameXLSM0 As String  'Имя предыдущего файла с расширением
    Dim NameFull0 As String  'Полное имя предыдущего файла с расширением
    Dim Name0 As String  'Имя предыдущего файла без расширения
    Dim dtName As Date  'Дата для преобразования (для вычитания 1)
    Dim intLenght As Integer  'Длина имени открываемого файла с расширением

Application.DisplayAlerts = False
On Error GoTo MsgErr
      
    'Определение имени текущего (открываемого) файла и преобразование его в дату.
    NameXLSM1 = ActiveWorkbook.Name
    intLenght = Len(NameXLSM1)
    Name1 = Left(NameXLSM1, intLenght - 4)    ' Отсекает 4 знака слева
    dtName = CDate(Name1)
      
    'Вычитание из названия файла 1 (т.е. определение имени предыдущего файла).
    dtName = dtName - 1
    Name0 = Format(dtName, "yyyy/mm/dd")
      
    ' Открытие макросом предыдущего файла .
    NameFull0 = ActiveWorkbook.Path & "\" & Name0 & ".xls"
    Workbooks.Open Filename:=NameFull0
    NameXLSM0 = Name0 & ".xls"
    Windows(NameXLSM0).Activate
      
    ' Копирование содержимого предыдущего файла .
    Application.DisplayAlerts = False 'Чтобы на задавал вопросов
    Range("V39").Select
    Selection.Copy
    
    'Закрытие предыдущего файла.
    ActiveWindow.Close
      
    'Вставка данных из буфера обмена в указанное место нового файла.
    Windows(NameXLSM1).Activate
    Range("Q39").Select
    ActiveSheet.Paste
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Application.DisplayAlerts = True
    Exit Sub

MsgErr:
    MsgBox "Что-то пошло не так!", vbExclamation + vbOKOnly
    Application.DisplayAlerts = True

End Sub
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал: Name1 = Left(NameXLSM1, intLenght - 4)    ' Отсекает 4 знака слева
Слева?
There is no knowledge that is not power
 
  Всем огромнейшее спасибо!  Всё работает!
Изменено: Екселист - 22.06.2015 11:48:31
Страницы: 1
Читают тему
Наверх