Обработать ошибку, если файл не найден / Microsoft Office

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Обработать ошибку, если файл не найден

25 сообщений из 35, страница 1 из 2

все

Обработать ошибку, если файл не найден

#36264193

Oksana Slonevskaya

Гость

Как обработать ошибку, если требуется в цикле открывать файлы, а како-либо из файлов не найден? Как сделать так, чтобы выводилась ошибка, какого файла нет, но цикл при этом не прерывался? Заранее спасибо

Private Sub CommandButton1_Click()
Dim dFirstDate As Date 'объявление переменных
Dim dLastDate As Date
Dim dDate As Date
Dim iDay As Integer
Dim iMonthNum As Integer
Dim iYear As Integer
Dim iTempY As Integer
Dim iTempM As Integer
Dim j As Integer
Dim k As Integer
Dim q As Integer
Dim h As Integer
Dim iTempD As Integer
Dim t As Integer
Dim s As Integer
Dim sMonthName As String
Dim wb As Workbook
Dim OPS As Workbook
Dim wbRef As Workbook
Dim wbDaily As Workbook
Dim wbRefDaily As Workbook
Dim wbCps As Workbook
Dim wbCrush As Workbook
Dim wbReestr As Workbook
Dim wbBottl As Workbook
Dim wbHulls As Workbook

dFirstDate = ActiveWorkbook.Worksheets("Week Summary").Range("C7").Value 'определяем дату начала недели
dLastDate = ActiveWorkbook.Worksheets("Week Summary").Range("W7").Value 'определяем дату конца недели
Set OPS = ThisWorkbook

'определяем, введена ли начальная и конечная даты недели

If IsEmpty(ActiveWorkbook.Worksheets("Week Summary").Range("C7")) Then
MsgBox ("Введите дату начала недели в листе Week Summary")
ElseIf IsEmpty(ActiveWorkbook.Worksheets("Week Summary").Range("W7")) Then
MsgBox ("Введите дату конца недели в листе Week Summary")
Else
iTempY = 0 'временная переменная для определения года
iTempM = 0 'временная переменная для определения месяца

For dDate = dFirstDate To dLastDate
iMonthNum = DatePart("m", dDate) 'определение номера месяца
iDay = DatePart("d", dDate) 'определение номера дня
iYear = DatePart("yyyy", dDate) 'определение номера года
sMonthName = fGetMonthName(iMonthNum) 'вызов функции, которая возвращает название месяца по его номеру
Application.ScreenUpdating = False 'запрет обновления экрана
'проверка, соответствует ли начальный год и месяц текущему
If (iTempY <> iYear) Or (iTempM <> iMonthNum) Then
Set wb = Workbooks.Open("\\Shared Projects\Operations Reports\QC Reports - Crush & Seeds\" & iYear & "\QC Crush " & sMonthName & ".xls", False)
Set wbRef = Workbooks.Open("\\Shared Projects\Operations Reports\QC Reports - Refinery & Bottling\" & iYear & "\QC Report Refinery " & sMonthName & ".xls", False)
Set wbCps = Workbooks.Open("\\Shared Projects\Reports\Silos_Shifts\Season 2009\ЦПС-общий учет.xls", False)
Set wbReestr = Workbooks.Open("\\Shared Projects\Reports\Silos_Shifts\Season 2009\Реестр отходов .xls", False)
Set wbBottl = Workbooks.Open("\\Shared Projects\Operations Reports\Weekly Plant Report\" & iYear & "\сменный журнал " & sMonthName & ".xls", False)
Set wbHulls = Workbooks.Open("\\Operations Reports\Energy supplies\" & iYear & "\Gas & Hulls.xls", False)

On Error GoTo ErrHandler
iTempY = iYear 'присваиваем временную переменную текущему значению года
iTempM = iMonthNum 'присваиваем временную переменную текущему значению месяца
End If
'копирование нужных значений ячеек из файла QC Crush
For i = 1 To wb.Worksheets("Crush").UsedRange.Rows.Count
If wb.Worksheets.Item("Crush").Cells(i, 4).Value = iDay Then
If wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д1 Массовая доля сора,%") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(30, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д1 Массовая доля влаги,%") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(31, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д1 Массовая доля масла M0, %") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(32, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д1 Лузжистость при факт.влажности и сорности Л0,%") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(35, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д3Л Вынос ядра,%") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(37, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д7 Протеин, %") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(38, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д7 Массовая доля влаги, %") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(39, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д7 Массовая доля масла,%") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(40, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д3Л Массовая доля масла,%") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(41, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
End If
End If
Next i
'копирование нужных значений ячеек из файла QC Refinery
For j = 1 To wbRef.Worksheets("Flows in Process").UsedRange.Rows.Count
If wbRef.Worksheets.Item("Flows in Process").Cells(j, 4).Value = iDay Then
If wbRef.Worksheets.Item("Flows in Process").Cells(j, 6).Value = ("P10 Deodorised Oil Cold Test 1hr") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(44, 20 + (dDate - dFirstDate)).Value = wbRef.Worksheets.Item("Flows in Process").Cells(j, 34).Value
ElseIf wbRef.Worksheets.Item("Flows in Process").Cells(j, 6).Value = ("P10 Deodorised Oil Acid Value") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(45, 20 + (dDate - dFirstDate)).Value = wbRef.Worksheets.Item("Flows in Process").Cells(j, 34).Value
ElseIf wbRef.Worksheets.Item("Flows in Process").Cells(j, 6).Value = ("P10 Deodorised Oil Peroxide Value") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(47, 20 + (dDate - dFirstDate)).Value = wbRef.Worksheets.Item("Flows in Process").Cells(j, 34).Value
ElseIf wbRef.Worksheets.Item("Flows in Process").Cells(j, 6).Value = ("P1 Crude Oil Phosphorus (%)") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(48, 20 + (dDate - dFirstDate)).Value = wbRef.Worksheets.Item("Flows in Process").Cells(j, 34).Value
ElseIf wbRef.Worksheets.Item("Flows in Process").Cells(j, 6).Value = ("P10 Deodorised Oil Phosphorus (%)") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(49, 20 + (dDate - dFirstDate)).Value = wbRef.Worksheets.Item("Flows in Process").Cells(j, 34).Value
End If
End If
Next j
'копирование нужных значений ячеек из файлов Daily Report Crush & Silos за все числа месяца
For iTempD = 0 To iDay
iTempD = iDay
Set wbDaily = Workbooks.Open("\\Shared Projects\Operations Reports\Production Reports - Crush & Seeds\Daily Report Crush & Silos\Daily Report Crush & Silos " & sMonthName & " " & iYear & "\Daily Report Crush & Silos " & sMonthName & " " & iTempD & ".xls", False)
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(10, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(87, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(11, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(88, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(12, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(89, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(13, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(90, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(14, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(91, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(33, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(92, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(34, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(93, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(34, 9 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("Сводная").Cells(49, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(35, 9 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("Сводная").Cells(51, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(38, 9 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("Сводная").Cells(53, 11).Value
wbDaily.Close
'копирование необходимых ячеек из файлов Daily Report Refinery & Bottling за каждый день
Set wbRefDaily = Workbooks.Open("\\Shared Projects\Operations Reports\Production Reports\" & iYear & "\Production Report Refinery & Bottling " & sMonthName & " " & iYear & "\Daily Report Refinery & Bottling " & sMonthName & " " & iTempD & ".xls", False)
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(17, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(149, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(21, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(153, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(22, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(238, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(45, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(30, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(46, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(96, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(47, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(97, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(49, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(71, 11).Value
wbRefDaily.Close
'копирование данных из файла Daily Report Crushing&Handling
Set wbCrush = Workbooks.Open("\\Shared Projects\Operations Reports\Production Reports\SHIFTS Производственный отчет ПДМ-" & iYear & "\" & sMonthName & "\Daily Report Crushing&Handling " & sMonthName & " " & iTempD & ".xls", False)
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(41, 9 + (dDate - dFirstDate)).Value = wbCrush.Worksheets.Item("Отчет").Cells(9, 10).Value
wbCrush.Close
Next iTempD
'копирование данных из файла ЦПС-общий учет (по семечке)
For k = 1 To wbCps.Worksheets("Проверка семечка").UsedRange.Rows.Count
If wbCps.Worksheets.Item("Проверка семечка").Cells(k, 1).Value = dDate And wbCps.Worksheets.Item("Проверка семечка").Cells(k + 1, 1).Value = dDate Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(12, 9 + (dDate - dFirstDate)).Value = wbCps.Worksheets.Item("Проверка семечка").Cells(k, 5).Value + wbCps.Worksheets.Item("Проверка семечка").Cells(k + 1, 5).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(13, 9 + (dDate - dFirstDate)).Value = wbCps.Worksheets.Item("Проверка семечка").Cells(k, 6).Value + wbCps.Worksheets.Item("Проверка семечка").Cells(k + 1, 6).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(14, 9 + (dDate - dFirstDate)).Value = wbCps.Worksheets.Item("Проверка семечка").Cells(k + 1, 9).Value
End If
Next k
'копирование данных из файла ЦПС-общий учет (по шроту)
For q = 1 To wbCps.Worksheets("Проверка шрота").UsedRange.Rows.Count
If wbCps.Worksheets.Item("Проверка шрота").Cells(q, 1).Value = dDate And wbCps.Worksheets.Item("Проверка шрота").Cells(q + 1, 1).Value = dDate Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(28, 9 + (dDate - dFirstDate)).Value = wbCps.Worksheets.Item("Проверка шрота").Cells(q, 6).Value + wbCps.Worksheets.Item("Проверка шрота").Cells(q + 1, 6).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(29, 9 + (dDate - dFirstDate)).Value = wbCps.Worksheets.Item("Проверка шрота").Cells(q + 1, 7).Value
End If
Next q
'копирование данных из файла Реестр отходов
R = 0
For h = 1 To wbReestr.Worksheets("2009-2010").UsedRange.Rows.Count
If wbReestr.Worksheets.Item("2009-2010").Cells(h, 2).Value = dDate And wbReestr.Worksheets.Item("2009-2010").Cells(h, 4).Value = ("Лузга") Then
R = R + wbReestr.Worksheets.Item("2009-2010").Cells(h, 8).Value
End If
Next h
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(42, 9 + (dDate - dFirstDate)).Value = R
'копирование данных из папки Bottling сменные журналы
For t = 1 To wbBottl.Worksheets("Лист1").UsedRange.Columns.Count
If wbBottl.Worksheets("Лист1").Cells(1, t).Value = iDay And wbBottl.Worksheets("Лист1").Cells(1, t + 1).Value = iDay Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(52, 9 + (dDate - dFirstDate)).Value = wbBottl.Worksheets("Лист1").Cells(72, t + 1).Value
End If
Next t
'копирование данных из файла Gas & Hulls
For s = 1 To wbHulls.Worksheets("Потребление сменное").UsedRange.Rows.Count
If wbHulls.Worksheets("Потребление сменное").Cells(s, 3) = dDate Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(43, 9 + (dDate - dFirstDate)).Value = wbHulls.Worksheets("Потребление сменное").Cells(s, 10).Value + wbHulls.Worksheets("Потребление сменное").Cells(s + 1, 10).Value
End If
Next s

Next dDate

wb.Close
wbRef.Close
wbCps.Close (False)
wbReestr.Close
wbBottl.Close
wbHulls.Close

End If

ExitHandler:
Application.ScreenUpdating = True 'разрешение обновления экрана (чтобы видеть внесенные изменения)
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

...

Рейтинг:

0 / 0

21.10.2009, 13:37

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36264195

Oksana Slonevskaya

Гость

На данные момент если файл отсутствует, ошибка выводится, но прекращается работа всей процедуры, не знаю, как это преобразовать, чтобы процедура продолжалась

...

Рейтинг:

0 / 0

21.10.2009, 13:39

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36264226

Hugo121

Гость

Добавьте строку On Error GoTo FileOpenErrHandler перед открытием файлов, и придумайте новый FileOpenErrHandler для этого случая (с возвратом назад вместо выхода из кода, и с обработкой, что делать дальше в коде, если эти файлы не найдены).

...

Рейтинг:

0 / 0

21.10.2009, 13:48

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36264234

Hugo121

Гость

Возможно, в коде надо добавить обработку флагов присутствия этих файлов, а в обработчике эти флаги менять.

...

Рейтинг:

0 / 0

21.10.2009, 13:49

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36264248

Oksana Slonevskaya

Гость

Да я понимаю, что нужно сделать, но не знаю, как в коде это прописать. Не знакома с обработкой ошибок вообще и в циклах в частности. ХЭЛП!!!!

...

Рейтинг:

0 / 0

21.10.2009, 13:53

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36264468

Hugo121

Гость

Первое, что пришло в голову - сделать 6 индивидуальных обработчиков типа

Код: plaintext

1.
2.
3.

WbOpenErrHandler:
WbFlag =  1 
Go to  20

перед Set wbRef пишем 20:
Блок "'копирование нужных значений ячеек из файла QC Crush" заключаем в условие

Код: plaintext

1.
2.
3.

If WbFlag =  0  Then
...
End If

Ну и в конце, где wb.Close тоже в это условие.
Возможно есть и другие решения получше, я пока придумал такое :)

...

Рейтинг:

0 / 0

21.10.2009, 14:45

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36264509

Hugo121

Гость

Код: plaintext

GoTo  20 :

В следующем обработчике GoTo 30: и т.д., под каждый файл свой вариант. Ну и если надо тормознуть код и вывести ошибку, добавить MsgBox Err.Description.
Ещё есть мысль сделать универсальный обработчик, в котором анализировать Err.Description. Пока не проверил, как это сделать (Split ?)

...

Рейтинг:

0 / 0

21.10.2009, 14:52

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36264537

Hugo121

Гость

Да, Split можно использовать:

Код: plaintext

1.
2.
3.

ErrHandler:
arr = Split(Err.Description, "'")
MsgBox arr( 1 )

arr(1) равно fullpath неоткрытого файла, далее через Case можно ставить флаги.

...

Рейтинг:

0 / 0

21.10.2009, 14:58

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36264810

Oksana Slonevskaya

Гость

Что-то я не поняла, что такое флаги ((((. можно ли после возникновения ошибки предложить пользователю самому указать путь к файл через диалоговое окно "выбор файла", если файл не выбран. продолжить выполнение процедуры.

...

Рейтинг:

0 / 0

21.10.2009, 16:15

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36264916

Hugo121

Гость

Короче, 20:, 30: не нужны, работает такой код:

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.

Sub test()

Dim wb As Workbook
Dim wbRef As Workbook
Dim wbDaily As Workbook
Dim wbRefDaily As Workbook
Dim wbCps As Workbook
Dim wbCrush As Workbook
Dim wbReestr As Workbook
Dim wbBottl As Workbook
Dim wbHulls As Workbook


On Error GoTo OpenErrHandler

Set wb = Workbooks.Open("\\Shared Projects\Operations Reports\QC Reports - Crush & Seeds\" & iYear & "\QC Crush " & sMonthName & ".xls", False)
Set wbRef = Workbooks.Open("\\Shared Projects\Operations Reports\QC Reports - Refinery & Bottling\" & iYear & "\QC Report Refinery " & sMonthName & ".xls", False)
Set wbCps = Workbooks.Open("\\Shared Projects\Reports\Silos_Shifts\Season 2009\ЦПС-общий учет.xls", False)
Set wbReestr = Workbooks.Open("\\Shared Projects\Reports\Silos_Shifts\Season 2009\Реестр отходов .xls", False)
Set wbHulls = Workbooks.Open("\\Operations Reports\Energy supplies\" & iYear & "\Gas & Hulls.xls", False)

MsgBox "OK"
Exit Sub

OpenErrHandler:
arr = Split(Err.Description, "'")
Select Case arr( 1 )
Case "\\Shared Projects\Operations Reports\QC Reports - Crush & Seeds\" & iYear & "\QC Crush " & sMonthName & ".xls"
wbopen =  1 
Case "\\Shared Projects\Operations Reports\QC Reports - Refinery & Bottling\" & iYear & "\QC Report Refinery " & sMonthName & ".xls"
wbRefOpen =  1 
Case "\\Shared Projects\Reports\Silos_Shifts\Season 2009\ЦПС-общий учет.xls"
wbCpsOpen =  1 
Case "\\Shared Projects\Reports\Silos_Shifts\Season 2009\Реестр отходов .xls"
wbReestrOpen =  1 
Case "\\Operations Reports\Energy supplies\" & iYear & "\Gas & Hulls.xls"
wbHullsOpen =  1 
End Select

Err.Clear           ' Очищаем поля объекта Err.
Resume Next

End Sub

Что такое флаги - объясню, как я это понимаю - некая переменная, обычно Boolean, которая принимает значение 1 или 0 (ну или другое) в зависимости от ситуации, и в коде анализируется. Имхо название возможно навеяно флагом на почтовых ящиках в Америке, помните - есть письмо, есть флаг, нет письма - нет флага.
предложить пользователю самому указать путь к файлу - ну вот и придумай код в зависимости от флага, или даже сразу вместо определения флага в Case вставить диалог открытия файла. Но если пользователь укажет не тот файл - код отработает неверно.

...

Рейтинг:

0 / 0

21.10.2009, 16:41

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36265165

Hugo121

Гость

Добавлю - т.к. файлы открываются в цикле, надо в начале каждого цикла перед открытием файлов сбрасывать все флаги в 0 (иначе предыдущее значение флага "неудачное открытие" перенесётся на удачно открытый файл в следующем цикле).

...

Рейтинг:

0 / 0

21.10.2009, 17:50

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36265887

Oksana Slonevskaya

Гость

а сбрасывать их в ноль как? err.clear?

...

Рейтинг:

0 / 0

22.10.2009, 08:50

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36265955

Hugo121

Гость

Что-то я зациклился на обработчике, лучше наверное делать без него.

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.

Sub testtwo()

Dim wb As Workbook
Dim wbRef As Workbook
Dim wbCps As Workbook
Dim wbCrush As Workbook
Dim wbReestr As Workbook
Dim wbHulls As Workbook


On Error Resume Next ' временно меняем обработку ошибок на это

wbNotOpen =  0 
Set wb = Workbooks.Open("\\Shared Projects\Operations Reports\QC Reports - Crush & Seeds\" & iYear & "\QC Crush " & sMonthName & ".xls", False)
If Not wb Is Nothing Then 'если файл открылся, то дальнейшее пропускаем
Else 'иначе
    ChDir "\\Shared Projects\Operations Reports\QC Reports - Crush & Seeds\" & iYear & "\" 'чтоб меньше перебирать
    openxls = Application _
    .GetOpenFilename("QC Crush****.xls, *.xls", , "QC Crush****.xls", , False)
    If openxls <> False Then
    Set wb = Workbooks.Open(Filename:=openxls, ReadOnly:=False)
    Else
    wbNotOpen =  1  'если юзер отказался выбирать файл, обработать флаг далее в коде
    End If
End If

wbRefNotOpen =  0 
Set wbRef = Workbooks.Open("\\Shared Projects\Operations Reports\QC Reports - Refinery & Bottling\" & iYear & "\QC Report Refinery " & sMonthName & ".xls", False)
' здесь вставить код аналогично предыдущему

Set wbCps = Workbooks.Open("\\Shared Projects\Reports\Silos_Shifts\Season 2009\ЦПС-общий учет.xls", False)
' здесь вставить код аналогично предыдущему

Set wbReestr = Workbooks.Open("\\Shared Projects\Reports\Silos_Shifts\Season 2009\Реестр отходов .xls", False)
' здесь вставить код аналогично предыдущему

Set wbHulls = Workbooks.Open("\\Operations Reports\Energy supplies\" & iYear & "\Gas & Hulls.xls", False)
' здесь вставить код аналогично предыдущему

On Error GoTo ErrHandler 'обработка для всего остального кода

'здесь далее Ваш остальной код

MsgBox "OK" ' пока тестим данный код

ExitHandler:
Application.ScreenUpdating = True 'разрешение обновления экрана (чтобы видеть внесенные изменения)
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler

End Sub

сбрасывать их в ноль как? - да вот прямо так: wbNotOpen = 0
Я поменял название флага, так понятнее (wbNotOpen = 1 значит не открыли)
Можно обойтись без флагов, если заканчивать макрос (Exit Sub), если юзер не выбрал файл.
Но вот если он выберет не то файл, скопируются не те данные. Может встрить в код ещё проверку подлинности файла, например по значению определённой ячейки таблицы, где гарантированно должно быть уникальное значение для данного файла.

Про err.clear:

Код: plaintext

1.
2.

Следует отметить, что после обработки ошибки вызывается метод Err.Clear для сброса значений свойств объекта Err.

...

Рейтинг:

0 / 0

22.10.2009, 09:22

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36266085

Oksana Slonevskaya

Гость

у меня вообще не работает ничего (((( Переписала пременительно к другой кнопке, т.к. смысл одинковый, просто тут кода меньше. ругается на строку Select Case arr(1)

Private Sub CommandButton1_Click()

'Определяем переменные

Dim OPS As Workbook
Dim wbKontrol1 As Workbook
Dim wbKontrol2 As Workbook
Dim iTempY As Integer
Dim iTempM As Integer
Dim iMonthNum As Integer
Dim iDay As Integer
Dim iYear As Integer
Dim i As Integer
Dim iTempD As Integer
Dim SumPer As Single
Dim SumNed As Single
Dim sMonthName As String
Dim dDate As Date

dFirstDate = ActiveWorkbook.Worksheets("Week Summary").Range("C7").Value 'определяем дату начала недели
dLastDate = ActiveWorkbook.Worksheets("Week Summary").Range("W7").Value 'определяем дату конца недели
Set OPS = ThisWorkbook

'определяем, введена ли начальная и конечная даты недели

If IsEmpty(ActiveWorkbook.Worksheets("Week Summary").Range("C7")) Then
MsgBox ("Введите дату начала недели в листе Week Summary")
ElseIf IsEmpty(ActiveWorkbook.Worksheets("Week Summary").Range("W7")) Then
MsgBox ("Введите дату конца недели в листе Week Summary")
Else
iTempY = 0 'временная переменная для определения года
iTempM = 0 'временная переменная для определения месяца

For dDate = dFirstDate To dLastDate
iMonthNum = DatePart("m", dDate) 'определение номера месяца
iDay = DatePart("d", dDate) 'определение номера дня
iYear = DatePart("yyyy", dDate) 'определение номера года
sMonthName = fGetMonthName(iMonthNum) 'вызов функции, которая возвращает название месяца по его номеру
Application.ScreenUpdating = False 'запрет обновления экрана
'проверка, соответствует ли начальный год и месяц текущему
If (iTempY <> iYear) Or (iTempM <> iMonthNum) Then
'Set wbKontrol1 = Workbooks.Open("\\eu.dir.bunge.com\KEP\Shared Projects\Reports\Bottling_Shifts\" & iYear & "\Контроль налива\" & sMonthName & "\Контроль налива масла №1 " & sMonthName & " " & iTempD & ".xls", False)
'Set wbKontrol2 = Workbooks.Open("\\eu.dir.bunge.com\KEP\Shared Projects\Reports\Bottling_Shifts\" & iYear & "\Контроль налива\" & sMonthName & "\Контроль налива масла №2 " & sMonthName & " " & iTempD & ".xls", False)

iTempY = iYear 'присваиваем временную переменную текущему значению года
iTempM = iMonthNum 'присваиваем временную переменную текущему значению месяца
End If
'копирование данных из файлов Контроль налива №1, Контроль налива №2
For iTempD = 0 To iDay
iTempD = iDay
On Error GoTo OpenErrHandler

Set wbKontrol1 = Workbooks.Open("\\eu.dir.bunge.com\KEP\Shared Projects\Reports\Bottling_Shifts\" & iYear & "\Контроль налива\" & sMonthName & "\Контроль налива масла №1 " & sMonthName & " " & iTempD & ".xls", False)
Set wbKontrol2 = Workbooks.Open("\\eu.dir.bunge.com\KEP\Shared Projects\Reports\Bottling_Shifts\" & iYear & "\Контроль налива\" & sMonthName & "\Контроль налива масла №2 " & sMonthName & " " & iTempD & ".xls", False)
SumPer = 0
SumNed = 0
For i = 25 To UsedRange.Rows.Count
SumPer = SumPer + (wbKontrol1.Worksheets.Item("Total").Cells(i, 6).Value + wbKontrol2.Worksheets.Item("Total").Cells(i, 6).Value)
SumNed = SumNed + (wbKontrol1.Worksheets.Item("Total").Cells(i, 5).Value + wbKontrol2.Worksheets.Item("Total").Cells(i, 5).Value)
Next i

Next iTempD
OPS.Worksheets.Item("Data input Wastes & Losses").Cells(30, 9 + (dDate - dFirstDate)).Value = SumPer
OPS.Worksheets.Item("Data input Wastes & Losses").Cells(31, 9 + (dDate - dFirstDate)).Value = SumNed
wbKontrol1.Close
wbKontrol2.Close

Next dDate

End If
OpenErrHandler:
arr = Split(Err.Description, "'")
Select Case arr(1)
Case "\\Shared Projects\Reports\Bottling_Shifts\" & iYear & "\Контроль налива\" & sMonthName & "\Контроль налива масла №1 " & sMonthName & " " & iTempD & ".xls"
wbKontrol1Open = 1
Case "\\Shared Projects\Reports\Bottling_Shifts\" & iYear & "\Контроль налива\" & sMonthName & "\Контроль налива масла №2 " & sMonthName & " " & iTempD & ".xls"
wbKontrol2Open = 1

End Select

Err.Clear ' Очищаем поля объекта Err.
Resume Next

End Sub

...

Рейтинг:

0 / 0

22.10.2009, 10:13

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36266129

Hugo121

Гость

ругается на строку Select Case arr(1) - наверное от региональных установок зависит разделитель в arr = Split(Err.Description, "'") - у меня путь к файлу выделяется по ', наверное у Вас иначе.
Ну тогда делайте без обработчика, как я выше написал, так всё-же имхо лучше будет. Т.е. смотрим, если файл не открылся, тут же обрабатываем Nothing переменной. Правда я не уверен, будет ли переменная Nothing, если в предыдущем цикле файл открылся, может она останется с прежним значением. Проверьте сами. Иначе её надо скидывать в Nothing принудительно перед попыткой открыть файл.

...

Рейтинг:

0 / 0

22.10.2009, 10:27

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36266236

Oksana Slonevskaya

Гость

а вот это получается вообще не надо?

ExitHandler:
Application.ScreenUpdating = True 'разрешение обновления экрана (чтобы видеть внесенные изменения)
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler

...

Рейтинг:

0 / 0

22.10.2009, 11:00

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36266295

mds_world

Участник

Откуда: Ташкент

Сообщения: 27 530

Рейтинг: 0 / 0

Весь топик не читал.

Если надо определить существует ли файл, то, мне кажется, гораздо проще разрулить ситуацию с помощью функции Dir , чем искать выход по ошибке.

Заранее извиняюсь, если не в тему.

...

Рейтинг:

0 / 0

22.10.2009, 11:18

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36266378

Oksana Slonevskaya

Гость

так у меня куча там файлов открывается...куда вставлять On Error GoTo ErrHandler, если у меня открытие файла с путем присваивается 1-ый раз в начале, а потом еще в коде есть открытия файлов, для которых я тоже буду прописывать обработку ошибок...

...

Рейтинг:

0 / 0

22.10.2009, 11:42

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36266399

пробегал

Гость

Мне кажется правильнее прежде чем открывать файл, проверить его существование.

Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(filename) = True Then
'открываем файл
endif

...

Рейтинг:

0 / 0

22.10.2009, 11:52

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36266410

Hugo121

Гость

Если делать по моему второму варианту, тогда OpenErrHandler: не нужен.
А ваш блок ErrHandler и ExitHandler: остаётся, где и был.
Просто перед открытием файлов (уже в цикле) инструкция

Код: plaintext

On Error Resume Next ' временно меняем обработку ошибок на это

а далее, когда открытие файлов прошло, сразу меняем на

Код: plaintext

On Error GoTo ErrHandler 'обработка для всего остального кода

mds_world гораздо проще разрулить ситуацию с помощью функции Dir - я такое не делал, покажите на примере, может и впрямь удобнее будет.

...

Рейтинг:

0 / 0

22.10.2009, 11:54

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36266442

Deggasad

Участник

Откуда: Воронеж

Сообщения: 3 509

Рейтинг: 0 / 0

Hugo121Если делать по моему второму варианту, тогда OpenErrHandler: не нужен.
А ваш блок ErrHandler и ExitHandler: остаётся, где и был.
Просто перед открытием файлов (уже в цикле) инструкция

Код: plaintext

On Error Resume Next ' временно меняем обработку ошибок на это

а далее, когда открытие файлов прошло, сразу меняем на

Код: plaintext

On Error GoTo ErrHandler 'обработка для всего остального кода

mds_world гораздо проще разрулить ситуацию с помощью функции Dir - я такое не делал, покажите на примере, может и впрямь удобнее будет.

Тынц

...

Рейтинг:

0 / 0

22.10.2009, 12:04

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36266489

Hugo121

Гость

т.е. вместо

Код: plaintext

If Not wb Is Nothing Then 'если файл открылся, то дальнейшее пропускаем

пишем

Код: plaintext

If Dir(полное_имя_файла) = "" Then

Тоже вариант. Эту проверку можно в начале каждого цикла делать, далее опять наверное флаги и т.п. Но вроде мудрёнее получается в итоге...

...

Рейтинг:

0 / 0

22.10.2009, 12:16

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36266511

mds_world

Участник

Откуда: Ташкент

Сообщения: 27 530

Рейтинг: 0 / 0

Hugo121,
никаких флагов не надо делать. Простой цикл даст только те файлы, которые подходят по маске в заданой папке

Код: plaintext

1.
2.
3.
4.

    f = Dir(PathName & "*.xls") ' PathName - путь к заданой папке
    Do While Not f = ""
        ' Здесь делать обработку
        f = Dir
    Loop

...

Рейтинг:

0 / 0

22.10.2009, 12:24

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36266544

Hugo121

Гость

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

...

Рейтинг:

0 / 0

22.10.2009, 12:32

| Ответить | Цитировать | Написать

Обработать ошибку, если файл не найден

#36266557

Oksana Slonevskaya

Гость

я вообще окончательно запуталась... можно применительно к этому коду показать?

Private Sub CommandButton1_Click()
Dim dFirstDate As Date 'объявление переменных
Dim dLastDate As Date
Dim dDate As Date
Dim iDay As Integer
Dim iMonthNum As Integer
Dim iYear As Integer
Dim iTempY As Integer
Dim iTempM As Integer
Dim j As Integer
Dim k As Integer
Dim q As Integer
Dim h As Integer
Dim iTempD As Integer
Dim t As Integer
Dim s As Integer
Dim sMonthName As String
Dim wb As Workbook
Dim OPS As Workbook
Dim wbRef As Workbook
Dim wbDaily As Workbook
Dim wbRefDaily As Workbook
Dim wbCps As Workbook
Dim wbCrush As Workbook
Dim wbReestr As Workbook
Dim wbBottl As Workbook
Dim wbHulls As Workbook

dFirstDate = ActiveWorkbook.Worksheets("Week Summary").Range("C7").Value 'определяем дату начала недели
dLastDate = ActiveWorkbook.Worksheets("Week Summary").Range("W7").Value 'определяем дату конца недели
Set OPS = ThisWorkbook

'определяем, введена ли начальная и конечная даты недели

If IsEmpty(ActiveWorkbook.Worksheets("Week Summary").Range("C7")) Then
MsgBox ("Введите дату начала недели в листе Week Summary")
ElseIf IsEmpty(ActiveWorkbook.Worksheets("Week Summary").Range("W7")) Then
MsgBox ("Введите дату конца недели в листе Week Summary")
Else
iTempY = 0 'временная переменная для определения года
iTempM = 0 'временная переменная для определения месяца

For dDate = dFirstDate To dLastDate
iMonthNum = DatePart("m", dDate) 'определение номера месяца
iDay = DatePart("d", dDate) 'определение номера дня
iYear = DatePart("yyyy", dDate) 'определение номера года
sMonthName = fGetMonthName(iMonthNum) 'вызов функции, которая возвращает название месяца по его номеру
Application.ScreenUpdating = False 'запрет обновления экрана
'проверка, соответствует ли начальный год и месяц текущему
If (iTempY <> iYear) Or (iTempM <> iMonthNum) Then
Set wb = Workbooks.Open("\\Shared Projects\Operations Reports\QC Reports - Crush & Seeds\" & iYear & "\QC Crush " & sMonthName & ".xls", False)
Set wbRef = Workbooks.Open("\\Shared Projects\Operations Reports\QC Reports - Refinery & Bottling\" & iYear & "\QC Report Refinery " & sMonthName & ".xls", False)
Set wbCps = Workbooks.Open("\\Shared Projects\Reports\Silos_Shifts\Season 2009\ЦПС-общий учет.xls", False)
Set wbReestr = Workbooks.Open("\\Shared Projects\Reports\Silos_Shifts\Season 2009\Реестр отходов.xls", False)
Set wbBottl = Workbooks.Open("\\Shared Projects\Operations Reports\Weekly Plant Report\" & iYear & "\BOTTLING - СМЕННЫЕ ЖУРНАЛЫ\KEP_Bottling - сменный журнал " & sMonthName & ".xls", False)
Set wbHulls = Workbooks.Open("\\Shared Projects\Operations Reports\Energy supplies\" & iYear & "\Gas & Hulls.xls", False)

' On Error GoTo ErrHandler
iTempY = iYear 'присваиваем временную переменную текущему значению года
iTempM = iMonthNum 'присваиваем временную переменную текущему значению месяца
End If
'копирование нужных значений ячеек из файла QC Crush
For i = 1 To wb.Worksheets("Crush").UsedRange.Rows.Count
If wb.Worksheets.Item("Crush").Cells(i, 4).Value = iDay Then
If wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д1 Массовая доля сора,%") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(30, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д1 Массовая доля влаги,%") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(31, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д1 Массовая доля масла M0, %") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(32, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д1 Лузжистость при факт.влажности и сорности Л0,%") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(35, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д3Л Вынос ядра,%") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(37, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д7 Протеин, %") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(38, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д7 Массовая доля влаги, %") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(39, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д7 Массовая доля масла,%") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(40, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
ElseIf wb.Worksheets.Item("Crush").Cells(i, 5).Value = ("Д3Л Массовая доля масла,%") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(41, 20 + (dDate - dFirstDate)).Value = wb.Worksheets.Item("Crush").Cells(i, 32).Value
End If
End If
Next i
'копирование нужных значений ячеек из файла QC Refinery
For j = 1 To wbRef.Worksheets("Flows in Process").UsedRange.Rows.Count
If wbRef.Worksheets.Item("Flows in Process").Cells(j, 4).Value = iDay Then
If wbRef.Worksheets.Item("Flows in Process").Cells(j, 6).Value = ("P10 Deodorised Oil Cold Test 1hr") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(44, 20 + (dDate - dFirstDate)).Value = wbRef.Worksheets.Item("Flows in Process").Cells(j, 34).Value
ElseIf wbRef.Worksheets.Item("Flows in Process").Cells(j, 6).Value = ("P10 Deodorised Oil Acid Value") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(45, 20 + (dDate - dFirstDate)).Value = wbRef.Worksheets.Item("Flows in Process").Cells(j, 34).Value
ElseIf wbRef.Worksheets.Item("Flows in Process").Cells(j, 6).Value = ("P10 Deodorised Oil Peroxide Value") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(47, 20 + (dDate - dFirstDate)).Value = wbRef.Worksheets.Item("Flows in Process").Cells(j, 34).Value
ElseIf wbRef.Worksheets.Item("Flows in Process").Cells(j, 6).Value = ("P1 Crude Oil Phosphorus (%)") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(48, 20 + (dDate - dFirstDate)).Value = wbRef.Worksheets.Item("Flows in Process").Cells(j, 34).Value
ElseIf wbRef.Worksheets.Item("Flows in Process").Cells(j, 6).Value = ("P10 Deodorised Oil Phosphorus (%)") Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(49, 20 + (dDate - dFirstDate)).Value = wbRef.Worksheets.Item("Flows in Process").Cells(j, 34).Value
End If
End If
Next j
'копирование нужных значений ячеек из файлов Daily Report Crush & Silos за все числа месяца
For iTempD = 0 To iDay
iTempD = iDay
Set wbDaily = Workbooks.Open("\\Shared Projects\Operations Reports\Production Reports - Crush & Seeds\Daily Report Crush & Silos\Daily Report Crush & Silos " & sMonthName & " " & iYear & "\Daily Report Crush & Silos " & sMonthName & " " & iTempD & ".xls", False)
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(10, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(87, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(11, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(88, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(12, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(89, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(13, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(90, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(14, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(91, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(33, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(92, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(34, 20 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("QA Seeds").Cells(93, 3).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(34, 9 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("Сводная").Cells(49, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(35, 9 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("Сводная").Cells(51, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(38, 9 + (dDate - dFirstDate)).Value = wbDaily.Worksheets.Item("Сводная").Cells(53, 11).Value
wbDaily.Close
'копирование необходимых ячеек из файлов Daily Report Refinery & Bottling за каждый день
Set wbRefDaily = Workbooks.Open("\\Shared Projects\Operations Reports\Production Reports - Refinery & Bottling\" & iYear & "\Production Report Refinery & Bottling " & sMonthName & " " & iYear & "\Daily Report Refinery & Bottling " & sMonthName & " " & iTempD & ".xls", False)
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(17, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(149, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(21, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(153, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(22, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(238, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(45, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(30, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(46, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(96, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(47, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(97, 11).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(49, 9 + (dDate - dFirstDate)).Value = wbRefDaily.Worksheets.Item("Сводная").Cells(71, 11).Value
wbRefDaily.Close
'копирование данных из файла Daily Report Crushing&Handling
Set wbCrush = Workbooks.Open("\\Shared Projects\Operations Reports\Production Reports - Crush & Seeds\SHIFTS Производственный отчет ПДМ-" & iYear & "\" & sMonthName & "\Daily Report Crushing&Handling " & sMonthName & " " & iTempD & ".xls", False)
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(41, 9 + (dDate - dFirstDate)).Value = wbCrush.Worksheets.Item("Отчет").Cells(9, 10).Value
wbCrush.Close
Next iTempD
'копирование данных из файла ЦПС-общий учет (по семечке)
For k = 1 To wbCps.Worksheets("Проверка семечка").UsedRange.Rows.Count
If wbCps.Worksheets.Item("Проверка семечка").Cells(k, 1).Value = dDate And wbCps.Worksheets.Item("Проверка семечка").Cells(k + 1, 1).Value = dDate Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(12, 9 + (dDate - dFirstDate)).Value = wbCps.Worksheets.Item("Проверка семечка").Cells(k, 5).Value + wbCps.Worksheets.Item("Проверка семечка").Cells(k + 1, 5).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(13, 9 + (dDate - dFirstDate)).Value = wbCps.Worksheets.Item("Проверка семечка").Cells(k, 6).Value + wbCps.Worksheets.Item("Проверка семечка").Cells(k + 1, 6).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(14, 9 + (dDate - dFirstDate)).Value = wbCps.Worksheets.Item("Проверка семечка").Cells(k + 1, 9).Value
End If
Next k
'копирование данных из файла ЦПС-общий учет (по шроту)
For q = 1 To wbCps.Worksheets("Проверка шрота").UsedRange.Rows.Count
If wbCps.Worksheets.Item("Проверка шрота").Cells(q, 1).Value = dDate And wbCps.Worksheets.Item("Проверка шрота").Cells(q + 1, 1).Value = dDate Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(28, 9 + (dDate - dFirstDate)).Value = wbCps.Worksheets.Item("Проверка шрота").Cells(q, 6).Value + wbCps.Worksheets.Item("Проверка шрота").Cells(q + 1, 6).Value
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(29, 9 + (dDate - dFirstDate)).Value = wbCps.Worksheets.Item("Проверка шрота").Cells(q + 1, 7).Value
End If
Next q
'копирование данных из файла Реестр отходов
R = 0
For h = 1 To wbReestr.Worksheets("2009-2010").UsedRange.Rows.Count
If wbReestr.Worksheets.Item("2009-2010").Cells(h, 2).Value = dDate And wbReestr.Worksheets.Item("2009-2010").Cells(h, 4).Value = ("Лузга") Then
R = R + wbReestr.Worksheets.Item("2009-2010").Cells(h, 8).Value
End If
Next h
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(42, 9 + (dDate - dFirstDate)).Value = R
'копирование данных из папки Bottling сменные журналы
For t = 1 To wbBottl.Worksheets("Лист1").UsedRange.Columns.Count
If wbBottl.Worksheets("Лист1").Cells(1, t).Value = iDay And wbBottl.Worksheets("Лист1").Cells(1, t + 1).Value = iDay Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(52, 9 + (dDate - dFirstDate)).Value = wbBottl.Worksheets("Лист1").Cells(72, t + 1).Value
End If
Next t
'копирование данных из файла Gas & Hulls
For s = 1 To wbHulls.Worksheets("Потребление сменное").UsedRange.Rows.Count
If wbHulls.Worksheets("Потребление сменное").Cells(s, 3) = dDate Then
OPS.Worksheets.Item("Data input Volumes & Quality").Cells(43, 9 + (dDate - dFirstDate)).Value = wbHulls.Worksheets("Потребление сменное").Cells(s, 10).Value + wbHulls.Worksheets("Потребление сменное").Cells(s + 1, 10).Value
End If
Next s

Next dDate

wb.Close
wbRef.Close
wbCps.Close (False)
wbReestr.Close
wbBottl.Close
wbHulls.Close

End If

ExitHandler:
Application.ScreenUpdating = True 'разрешение обновления экрана (чтобы видеть внесенные изменения)
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

Буду очень признательна. только постигаю азы VBA

...

Рейтинг:

0 / 0

22.10.2009, 12:34

| Ответить | Цитировать | Написать

25 сообщений из 35, страница 1 из 2

все

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Обработать ошибку, если файл не найден

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=61&msg=36266442&tid=2178939]:	0ms
get settings:	8ms
get forum list:	16ms
check forum access:	3ms
check topic access:	3ms
track hit:	169ms
get topic data:	10ms
get forum data:	3ms
get page messages:	67ms
get tp. blocked users:	1ms
others:	217ms

total:	497ms

	Необходимые cookie
	Cookie для сбора статистики
	Cookie для маркетинга и рекламы