Добавление обработки ошибок для проверки условия перед выполнением - PullRequest
0 голосов
/ 20 марта 2019

Здравствуйте, и чем все вы за свое время, у меня есть код ниже, в моей электронной таблице есть кнопка RUN, которая выполняет макрос SUB RUN ALL. При первом вызове функция удаляет все вкладки и импортирует лист из файла на моем рабочем столе с именем «MyFiles».

Я хочу сначала проверить наличие этого файла, прежде чем делать что-либо еще, и, если его там нет, отобразить короткое сообщение и выйти из подпрограммы и больше ничего не запускать.

Должен ли я включить что-то в подпункт ИМПОРТ ДАННЫХ? или создайте новый саб для запуска первым и проверьте этот файл и выйдите, если его нет?

Заранее благодарю всех.

Sub Run_All()

Call Import_Data
Call Cut_Series2
Call Cut_Series5
Call Cut_Series6
Call Cut_Series8
Call Cut_SeriesH
Call Cut_Trailers
Call Cut_PPE
Call Cut_Dewatering
Call Cut_Nicolas
Call Cut_Facilities

End Sub



Sub Import_Data()

Dim x As Workbook
Dim targetWorkbook As Workbook
Dim xWs As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

' This part delets all sheets except the summary tab
     For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Summary" Then
            xWs.Delete
        End If
    Next

' This part will get the raw data from the downloaded file on the desktop
     Set x = Workbooks.Open("C:\Users\mohammad.reza\Desktop\MyFiles.xls")
     Set targetWorkbook = Application.ActiveWorkbook

' This part will copy the sheet into this workbook
     With x.Sheets("MyFiles").UsedRange
     ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Range("A1").Resize( _
        .Rows.Count, .Columns.Count) = .Value
     End With
     x.Close

' This part will rename the sheet and move it to the end
ActiveSheet.Name = "RAW DATA"
ActiveSheet.Move After:=Worksheets(Worksheets.Count)

Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub

1 Ответ

1 голос
/ 20 марта 2019

Если вы сделаете Import_Data в функции, вы можете возвратить успех / неудачу и выйти из своей команды man, если файл не найден.

Sub Run_All()

    If Not Import_Data() Then Exit Sub
    Cut_Series2
    'etc

End Sub



Function Import_Data() As Boolean
    Const F_PATH As String = "C:\Users\mohammad.reza\Desktop\MyFiles.xls"

    'if no file then exit and return false
    If Dir(F_PATH) = "" Then
        Import_Data = False
        Exit Function
    End If

    'load the file

    Import_Data = True '=success

End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...