Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.93/14: Рейтинг темы: голосов - 14, средняя оценка - 4.93
mag_svyatoslav
1

VBA Excel 2007. Ошибка в методе ListFillRange

12.04.2012, 21:40. Показов 2835. Ответов 3
Метки нет (Все метки)

Здравствуйте, самый обычный макрос формирования таблицы из базы данных в Excel 2007. Разбираюсь в программировании очень плохо, поэтому извините за банальное непонимание простейших вещей.

Visual Basic
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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
Dim GroupCell, MaterialsCell
 
Private Function IgnorErr()
    Dim MaterialsCell
    
    On Error Resume Next
    Err.Raise 6
    Err.Clear
End Function
 
Sub ОпредПерем()
    GroupCell = "B" & 13 + Лист1.Layer.Value
    MaterialsCell = "A" & 13 + Лист1.Layer.Value
End Sub
 
Sub Layer_Change()
    Лист1.Activate
    ОпредПерем
 
    Group.LinkedCell = GroupCell
    Group_Change
    Materials.LinkedCell = MaterialsCell
    
    If Лист1.Range(MaterialsCell).Value = Null Then
        Group.Value = Лист1.Range(GroupCell).Value
        Materials.Value = Лист1.Range(MaterialsCell).Value
    Else
        Лист1.Range(GroupCell).Value = Group.Value
        Лист1.Range(MaterialsCell).Value = Materials.Value
    End If
 
    Columns("Z:Z").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
    ("Z1:Z2"), Unique:=False
    Rows("14:65").EntireRow.AutoFit
End Sub
 
Private Sub Group_Change()
    If Group.Value = 1 Then Materials.ListFillRange = "Интервал11"
    If Group.Value = 2 Then Materials.ListFillRange = "Интервал12"
    If Group.Value = 3 Then Materials.ListFillRange = "Интервал13"
    If Group.Value = 4 Then Materials.ListFillRange = "Интервал14"
    If Group.Value = 5 Then Materials.ListFillRange = "Интервал15"
    If Group.Value = 6 Then Materials.ListFillRange = "Интервал16"
    If Group.Value = 7 Then Materials.ListFillRange = "Интервал17"
    If Group.Value = 8 Then Materials.ListFillRange = "Интервал18"
    If Group.Value = 9 Then Materials.ListFillRange = "Интервал19"
    If Group.Value = 10 Then Materials.ListFillRange = "Интервал20"
    If Group.Value = 11 Then Materials.ListFillRange = "Интервал21"
    If Group.Value = 12 Then Materials.ListFillRange = "Интервал22"
    If Group.Value = 13 Then Materials.ListFillRange = "Интервал23"
    If Group.Value = 14 Then Materials.ListFillRange = "Интервал24"
    If Group.Value = 15 Then Materials.ListFillRange = "Интервал25"
    If Group.Value = 16 Then Materials.ListFillRange = "Интервал26"
    If Group.Value = 17 Then Materials.ListFillRange = "Интервал27"
    If Group.Value = 18 Then Materials.ListFillRange = "Интервал28"
    If Group.Value = 19 Then Materials.ListFillRange = "Интервал29"
    If Group.Value = 20 Then Materials.ListFillRange = "Интервал30"
End Sub
 
 
Private Sub Materials_Click()
    Columns("Z:Z").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
    ("Z1:Z2"), Unique:=False
    Rows("14:65").EntireRow.AutoFit
    
    ОпредПерем
    
    If Materials.ListFillRange = "Интервал11" Then Group.Value = 1
    If Materials.ListFillRange = "Интервал12" Then Group.Value = 2
    If Materials.ListFillRange = "Интервал13" Then Group.Value = 3
    If Materials.ListFillRange = "Интервал14" Then Group.Value = 4
    If Materials.ListFillRange = "Интервал15" Then Group.Value = 5
    If Materials.ListFillRange = "Интервал16" Then Group.Value = 6
    If Materials.ListFillRange = "Интервал17" Then Group.Value = 7
    If Materials.ListFillRange = "Интервал18" Then Group.Value = 8
    If Materials.ListFillRange = "Интервал19" Then Group.Value = 9
    If Materials.ListFillRange = "Интервал20" Then Group.Value = 10
    If Materials.ListFillRange = "Интервал21" Then Group.Value = 11
    If Materials.ListFillRange = "Интервал22" Then Group.Value = 12
    If Materials.ListFillRange = "Интервал23" Then Group.Value = 13
    If Materials.ListFillRange = "Интервал24" Then Group.Value = 14
    If Materials.ListFillRange = "Интервал25" Then Group.Value = 15
    If Materials.ListFillRange = "Интервал26" Then Group.Value = 16
    If Materials.ListFillRange = "Интервал27" Then Group.Value = 17
    If Materials.ListFillRange = "Интервал28" Then Group.Value = 18
    If Materials.ListFillRange = "Интервал29" Then Group.Value = 19
    If Materials.ListFillRange = "Интервал30" Then Group.Value = 20
End Sub
 
Private Sub Очистить_Click()
    ОпредПерем
    Layer.Activate
    Layer.Value = Лист1.Range("K4").Value - 1
    
    Лист1.Range(GroupCell).Value = Null
    Лист1.Range(MaterialsCell).Value = Null
End Sub
 
Private Sub Переход_Click()
    ОпредПерем
    Лист2.Activate
    ActiveSheet.Cells(Лист1.Range(MaterialsCell).Value + 3, 6).Select
End Sub
При вызове процедуры «Переход в базу данных к материалу» возникает ошибка:

Run-time error '1004':
Method 'Range' of object '_Worksheet' failed


Погуглил, добавил функцию сразу после определения переменных:


Visual Basic
1
2
3
4
5
6
7
Private Function IgnorErr() 
    Dim MaterialsCell
 
    On Error Resume Next
    Err.Raise 6
    Err.Clear 
End Function
Помогло, ошибка не возникает!

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

Run-time error '2147417848' (80010108)':
Method 'ListFillRange' object 'IMdcList' failed


Отладчик сбрасывает на Materials.ListFillRange = "Интервал**" в процедуре Group_Change()

Подключил базу “Microsoft DAO 3.51 Object Library”, - не помогло.

Вопрос! Что Я не правильно сделал? Можно ли выполнить игнорирование ошибки в данном случае, но так чтобы файл при этом сохранялся? Какая функция для этого нужна?

Возможно, не лишним будет сказать, что у меня есть еще одна таблица Excel, которая предназначена для расчета совершенно других данных, но с идентичным кодом и все работает как часы. Офис переустанавливал, даже заново переделывал файл (думал что где-то внутренняя ошибка), но безрезультатно.
__________________
Помощь в написании контрольных, курсовых и дипломных работ здесь
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
12.04.2012, 21:40
Ответы с готовыми решениями:

VBA excel 2007 и Power point (Please help!)
Уважаемые форумчане, подскажите пожалуйста, в чем ошибка! Задача: при нажатии кнопки на листе...

VBA Excel 2007, Работа с символьными данными
помогите пожалуйста решить: - Подсчитать, сколько в строке слов, содержащих буквосочетание 'мн'....

Excel 2007 VBA. Функция с двумя аргументами не хочет работать
Компилятор ругается, на CulculationCumulativeNormalFunction (dbDelta1, dbNDFd1) говорит что...

Обработка в Excel 2007 табличных данных с использованием макросов на VBA
Помоооогите пожалуйста, братцы, сделать лабораторку, ОЧЕНЬ СРОЧНО!!! Буду безумно благодарен, если...

3
15038 / 6362 / 1726
Регистрация: 24.09.2011
Сообщений: 9,971
13.04.2012, 10:16 2
Цитата Сообщение от mag_svyatoslav Посмотреть сообщение
При вызове процедуры «Переход в базу данных к материалу» возникает ошибка:
Run-time error '1004':
Method 'Range' of object '_Worksheet' failed
При останове, выясните, чему равны значения переменных. Это можно посмотреть в окне Locals или "спросить" в окне Immediate, например:
Visual Basic
1
?Лист1.Layer.Value
Это короткая запись команды
Visual Basic
1
Debug.Print Лист1.Layer.Value
Run-time error '1004' обычно возникает при попытке обратиться к диапазону с недопустимым именем, например range("A0")
Цитата Сообщение от mag_svyatoslav Посмотреть сообщение
Погуглил, добавил функцию сразу после определения переменных:
...
Помогло, ошибка не возникает!
Проще добавить
Visual Basic
1
On Error Resume Next
в начале основной процедуры.

Добавлено через 9 минут
Процедуру можно оптимизировать:
Visual Basic
1
2
3
Private Sub Group_Change()
    If Group.Value >= 1 And Group.Value <= 20 Then Materials.ListFillRange = "Интервал" & Group.Value + 10
End Sub
Строки 68-87
Visual Basic
1
    If Materials.ListFillRange Like "Интервал*" Then Group.Value = CLng(Replace(Materials.ListFillRange, "Интервал", ""))
Возможно, и проверки можно убрать.
0
2774 / 708 / 104
Регистрация: 04.02.2011
Сообщений: 1,433
13.04.2012, 11:50 3
Что такое Лист1.Layer? Возможно того, что вы под этим подразумеваете просто не существует =)
0
mag_svyatoslav
14.04.2012, 02:03 4
Короче, не спал всю ночь, мудрил-мудрил сам не понимаю что и вымудрил обход ошибок. Работает теперь отлично.

Visual Basic
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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
Dim GroupCell As String
 
Sub Layer_Change()
    Dim MaterialsCell As String
    On Error Resume Next
    Err.Raise 6
    Err.Clear
 
    With Лист1
       .Activate
    '    GroupCell = "B" & 13 + Layer.Value
    '    MaterialsCell = "A" & 13 + Layer.Value
        GroupCell = "B" & 13 + .Range("Номер_слоя").Value
        MaterialsCell = "A" & 13 + .Range("Номер_слоя").Value
        
        .Group.LinkedCell = GroupCell
        Group_Change
        .Materials.LinkedCell = MaterialsCell
        
        If .Range(MaterialsCell).Value = Null Then
            .Group.Value = .Range(GroupCell).Value
            .Materials.Value = .Range(MaterialsCell).Value
        Else
            .Range(GroupCell).Value = Group.Value
            .Range(MaterialsCell).Value = Materials.Value
        End If
        
        .Columns("Z:Z").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("Z1:Z2"), Unique:=False
        .Rows("14:65").EntireRow.AutoFit
    End With
End Sub
 
Private Sub Group_Change()
    Dim MaterialsList As String
    On Error Resume Next
    Err.Raise 6
    Err.Clear
    
    With Лист1
        If .Group.Value = 1 Then MaterialsList = "Интервал11"
        If .Group.Value = 2 Then MaterialsList = "Интервал12"
        If .Group.Value = 3 Then MaterialsList = "Интервал13"
        If .Group.Value = 4 Then MaterialsList = "Интервал14"
        If .Group.Value = 5 Then MaterialsList = "Интервал15"
        If .Group.Value = 6 Then MaterialsList = "Интервал16"
        If .Group.Value = 7 Then MaterialsList = "Интервал17"
        If .Group.Value = 8 Then MaterialsList = "Интервал18"
        If .Group.Value = 9 Then MaterialsList = "Интервал19"
        If .Group.Value = 10 Then MaterialsList = "Интервал20"
        If .Group.Value = 11 Then MaterialsList = "Интервал21"
        If .Group.Value = 12 Then MaterialsList = "Интервал22"
        If .Group.Value = 13 Then MaterialsList = "Интервал23"
        If .Group.Value = 14 Then MaterialsList = "Интервал24"
        If .Group.Value = 15 Then MaterialsList = "Интервал25"
        If .Group.Value = 16 Then MaterialsList = "Интервал26"
        If .Group.Value = 17 Then MaterialsList = "Интервал27"
        If .Group.Value = 18 Then MaterialsList = "Интервал28"
        If .Group.Value = 19 Then MaterialsList = "Интервал29"
        If .Group.Value = 20 Then MaterialsList = "Интервал30"
    End With
    
    Materials.ListFillRange = MaterialsList
 
End Sub
 
 
Private Sub Materials_Click()
 
    Columns("Z:Z").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
    ("Z1:Z2"), Unique:=False
    Rows("14:65").EntireRow.AutoFit
    
    With Лист1
        If .Materials.ListFillRange = "Интервал11" Then Group.Value = 1
        If .Materials.ListFillRange = "Интервал12" Then Group.Value = 2
        If .Materials.ListFillRange = "Интервал13" Then Group.Value = 3
        If .Materials.ListFillRange = "Интервал14" Then Group.Value = 4
        If .Materials.ListFillRange = "Интервал15" Then Group.Value = 5
        If .Materials.ListFillRange = "Интервал16" Then Group.Value = 6
        If .Materials.ListFillRange = "Интервал17" Then Group.Value = 7
        If .Materials.ListFillRange = "Интервал18" Then Group.Value = 8
        If .Materials.ListFillRange = "Интервал19" Then Group.Value = 9
        If .Materials.ListFillRange = "Интервал20" Then Group.Value = 10
        If .Materials.ListFillRange = "Интервал21" Then Group.Value = 11
        If .Materials.ListFillRange = "Интервал22" Then Group.Value = 12
        If .Materials.ListFillRange = "Интервал23" Then Group.Value = 13
        If .Materials.ListFillRange = "Интервал24" Then Group.Value = 14
        If .Materials.ListFillRange = "Интервал25" Then Group.Value = 15
        If .Materials.ListFillRange = "Интервал26" Then Group.Value = 16
        If .Materials.ListFillRange = "Интервал27" Then Group.Value = 17
        If .Materials.ListFillRange = "Интервал28" Then Group.Value = 18
        If .Materials.ListFillRange = "Интервал29" Then Group.Value = 19
        If .Materials.ListFillRange = "Интервал30" Then Group.Value = 20
    End With
 
End Sub
 
Private Sub Очистить_Click()
 
    GroupCell = "B" & 13 + Лист1.Range("Номер_слоя").Value
    MaterialsCell = "A" & 13 + Лист1.Range("Номер_слоя").Value
 
    Лист1.Range(GroupCell).Value = Null
    Лист1.Range(MaterialsCell).Value = Null
 
End Sub
 
Private Sub Переход_Click()
    GroupCell = "B" & 13 + Лист1.Range("Номер_слоя").Value
    MaterialsCell = "A" & 13 + Лист1.Range("Номер_слоя").Value
 
    Лист2.Activate
    ActiveSheet.Cells(Лист1.Range(MaterialsCell).Value + 3, 6).Select
 
End Sub
Казанский спасибо за ответы, очень интересно для оптимизации.

Добавлено через 2 часа 6 минут
Результат после оптимизации:

Visual Basic
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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Dim GroupCell As String, MaterialsCell As String
 
Private Sub Opred_Perem()
    GroupCell = "B" & 13 + Лист1.Range("Номер_слоя").Value
    MaterialsCell = "A" & 13 + Лист1.Range("Номер_слоя").Value
End Sub
 
Private Sub Layer_Change()
    On Error Resume Next
 
    With Лист1
       .Activate
        Opred_Perem
        .Group.LinkedCell = GroupCell
        Group_Change
        .Materials.LinkedCell = MaterialsCell
        
        If .Range(MaterialsCell).Value = Null Then
            .Group.Value = .Range(GroupCell).Value
            .Materials.Value = .Range(MaterialsCell).Value
        Else
            .Range(GroupCell).Value = Group.Value
            .Range(MaterialsCell).Value = Materials.Value
        End If
        
        .Columns("Z:Z").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
        ("Z1:Z2"), Unique:=False
        .Rows("14:65").EntireRow.AutoFit
    End With
End Sub
 
Private Sub Group_Change()
    On Error Resume Next
    
    
    With Лист1
'        If .Group.Value >= 1 And .Group.Value <= 20 Then '_ 'отключил проверку (и правда! зачем она?)
        .Materials.ListFillRange = "Интервал" & .Group.Value + 10
    End With
 
End Sub
 
 
Private Sub Materials_Click()
 
    Columns("Z:Z").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
    ("Z1:Z2"), Unique:=False
    Rows("14:65").EntireRow.AutoFit
    
    With Лист1
'        If .Materials.ListFillRange Like "Интервал*" Then '_ 'отключил проверку
        .Group.Value = CLng(Replace(.Materials.ListFillRange, "Интервал", "")) - 10
    End With
End Sub
 
Private Sub Очистить_Click()
    Opred_Perem
 
    Лист1.Range(GroupCell).Value = Null
    Лист1.Range(MaterialsCell).Value = Null
End Sub
 
Private Sub Переход_Click()
    Opred_Perem
    
    Лист2.Activate
    ActiveSheet.Cells(Лист1.Range(MaterialsCell).Value + 3, 6).Select
End Sub
Казанский, еще раз СПАСИБО!!!
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
14.04.2012, 02:03

Как отключить работу клавиши Print Screen в VBA Excel 2007
Здравствуйте, специалисты! Как отключить работу клавиши Print Screen в VBA Excel 2007? Если этот...

Ошибка в методе xlApplication.Quit() при работе с excel
Пишу программу, которая создает отчет в excele импортирую библиотеку Imports...

Обмен данными между Access 2007 и Visio 2007 используя VBA
Доброго времени суток уважаемые товарищи!:) Суть: Решил я написать одну софтину которая бы...

HP M426fdn, ошибка печати на <принтер> в excel 2007
Всех приветствую. Office 2007 pro, Windows 7 pro. При попытке печати ряда документов, excel...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2022, CyberForum.ru