Вызов процедуры из функции

@Devils · Регистрация: 05.02.2015

Студворк — интернет-сервис помощи студентам

Всем привет.
Есть функция, которое ищет переданное ей значение в другой книге.

Функция PlugNumber

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
Public ExtWB As Object
Const PathWB = "Другая книга.xlsx"
 
Function PlugNumber(MAC As String) As String
Dim i As Integer
Dim ExtRange As Range, ExtResult As Range
Set ExtWB = GetObject(PathWB)
For i = 1 To ExtWB.Worksheets.Count
If ExtWB.Worksheets(i).FilterMode = True Then
ExtWB.Worksheets(i).ShowAllData
End If
Set ExtRange = ExtWB.Worksheets(i).UsedRange
Set ExtResult = ExtRange.Find(MAC, , xlValues)
If Not ExtResult Is Nothing Then
Exit For
End If
Next
 
If ExtResult Is Nothing Then
    PlugNumber = "Не найдено"
    Application.ThisCell.Font.Color = vbRed
Else
    PlugNumber = ExtWB.Worksheets(i).Range(ExtResult.Address).Offset(, 1).Value
    Call ChangeColor(ExtWB, i, ExtResult, PlugNumber)
    Application.ThisCell.Font.Color = vbBlack
    objExtwb.Close SaveChanges:=True
End If
End Function

Из функции происходит вызов процедуры

Процедура ChangeColor

Visual Basic
1
2
3
Sub ChangeColor(ByVal WB As Object, ByVal a As Integer, ByVal ExtAddr As Range)
    WB.Worksheets(a).Range(ExtAddr.Address).Interior.Color = RGB(0, 178, 80)
End Sub

По изменения в искомой книге не происходит.

Где ошибка?

@Prisioner · 03.03.2017, 15:26

Я не уверен, но возможно, книгу надо передать по ссылке, т.е. ByRef ?

Visual Basic
1
2
3
Sub ChangeColor(ByRef WB As Object, ByVal a As Integer, ByVal ExtAddr As Range)
    WB.Worksheets(a).Range(ExtAddr.Address).Interior.Color = RGB(0, 178, 80)
End Sub

@Devils · 03.03.2017, 15:29 **[ТС]**

Prisioner, пробовал - не помогает.

@Prisioner · 03.03.2017, 15:38

Devils, позволю себе задать уточняющий вопрос - цвет должен изменяться в "Другой книге" или в основной?

@Devils · 03.03.2017, 15:39 **[ТС]**

Prisioner, в "Другой книге"

toiai · 03.03.2017, 15:52

Примера нет, а самому в лом, попробуйте использовать вместо Range -> Cells

@Devils · 03.03.2017, 16:01 **[ТС]**

toiai, самое интересное, что если в основной книге сделать кнопку и привязать процедуру (код почти аналогичен функции), то все отрабатывает.

Тестовая процедура

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub test()
Dim i As Integer
Dim ExtRange As Range, ExtResult As Range
Set ExtWB = GetObject(PathWB)
For i = 1 To ExtWB.Worksheets.Count
If ExtWB.Worksheets(i).FilterMode = True Then
ExtWB.Worksheets(i).ShowAllData
End If
Set ExtRange = ExtWB.Worksheets(i).UsedRange
Set ExtResult = ExtRange.Find(ActiveCell.Value, , xlValues)
If Not ExtResult Is Nothing Then
Exit For
End If
Next
If ExtResult Is Nothing Then
    ActiveCell.Value = "Не найдено"
    Application.ThisCell.Font.Color = vbRed
Else
    ExtWB.Worksheets(i).Range(ExtResult.Address).Interior.Color = RGB(0, 178, 80)
end if

@Vlad999 · 03.03.2017, 16:01

я не спец, просто интересно. у процедуры три параметра, а передаете четыре - это нормально?

@Devils · 03.03.2017, 16:05 **[ТС]**

Vlad999, это я очепятался... торопился

4 параметра нет. Т.е. процедуре из функции передается 3 параметра и процедура принимает 3 параметра.

@Prisioner · 03.03.2017, 16:38

Devils,

Попробовал у себя. При таком подходе:

Visual Basic
1
Set ExtWB = GetObject(PathWB)

У меня вообще книга назначения портится и перестает открываться после этого (хз почему).

Заменил на

Visual Basic
1
Set ExtWB = Workbooks.Open(PathWB)

И всё работает.

@Hugo121 · 03.03.2017, 16:47

Сообщение от Prisioner

книга назначения портится и перестает открываться после этого (хз почему).

Она не портится. И не перестаёт открываться

Просто если её так открыть - то рабочее окно скрыто. И если её в таком виде сохранить - то так и останется, окно будет скрытым, пока его кто-нибудь не сделает видимым.

@Devils · 03.03.2017, 17:04 **[ТС]**

Prisioner, забавно, при подходе, который указан мной, ничего не портится (Сколько макросов так работает и проблем нет, кроме этого случая :-) )
Мне интересен именно вариант GetObject

@Hugo121 · 03.03.2017, 17:18

Бывали случаи что какие-то файлы через GetObject не открывались, или открывались как-то криво, не выяснил с чем это было связано...

@Devils · 06.03.2017, 10:28 **[ТС]**

Че-то Workbooks.Open не хочет работать

Данные в переменную ExtWB не записывает.

@Devils · 06.03.2017, 10:39 **[ТС]**

Во вложении архив с 2 excel файлами.

@Hugo121 · 06.03.2017, 12:17

Фукнкции листа так не умеют.
Вызывайте макросом:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub tt()
    Dim x
    x = PlugNumber([a1])
End Sub
 
и кстати можно проще:
...
        Call ChangeColor(ExtResult)
...
 
Sub ChangeColor(ByVal ExtAddr As Range)
    ExtAddr.Interior.Color = RGB(0, 178, 80)
End Sub

Но тот обрабатываемый файл должен быть открыт, иначе
1. у меня вываливается в ошибку
2.Вы его кодом не отображаете и не сохраняете, т.е. всё равно изменений не увидите.

P.S. И даже не закрываете - что есть упущение!

Добавлено через 5 минут
Поправлюсь - п.1 в ошибку не выкидывает, можно пользовать. Но книгу нужно сохранить, а перед сохранением - отобразить окно.

@Devils · 06.03.2017, 13:38 **[ТС]**

Hugo121, при присвоении переменной ExtWb, книга открывается, т.е подтянуть данные из другой книги можно, а вот внести изменения из функции PlugNumber в другую книгу, видимо нельзя, даже если вызвать процедуру из функции

Но если создать отдельную процедуру, добавить кнопку, то все работает.
Вариант указанный вами:

Visual Basic
1
2
3
4
5
6
        Call ChangeColor(ExtResult)
...
 
Sub ChangeColor(ByVal ExtAddr As Range)
    ExtAddr.Interior.Color = RGB(0, 178, 80)
End Sub

Так и не работает

@Hugo121 · 06.03.2017, 17:53

Сообщение от Devils

Так и не работает

- чините там у себя, раз не работает. У меня работает как я описал - т.е. вызовом из процедуры, а не из функции.

@Devils · 07.03.2017, 15:36 **[ТС]**

Т.к. из функции нельзя вызвать процедуру с последующим изменением другого файла, то из ситуации вышел следующим образом.
Добавил в "ЭтаКнига" процедуру. Т.к. процедура Workbook_SheetChange реагирует на любые изменения, то сделал условия, при которой будет вызываться процедура ChangeColor

Workbook_SheetChange

Visual Basic
1
2
3
4
5
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
If Len(Source.Value) = 5 Or Len(Source.Value) = 6 Then
Call ChangeColor(Source.Offset(, -2).Value)
End If
End Sub

.
А теперь по порядку. После выполнении функции PlugNumber

PlugNumber

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
Public ExtWB As Object
Const PathWB = "Другая книга.xlsx"
 
Function PlugNumber(MAC As String) As String
Dim i As Integer
Dim ExtRange As Range, ExtResult As Range
Set ExtWB = GetObject(PathWB)
For i = 1 To ExtWB.Worksheets.Count
If ExtWB.Worksheets(i).FilterMode = True Then
ExtWB.Worksheets(i).ShowAllData
End If
Set ExtRange = ExtWB.Worksheets(i).UsedRange
Set ExtResult = ExtRange.Find(MAC, , xlValues)
If Not ExtResult Is Nothing Then
Exit For
End If
Next
 
If ExtResult Is Nothing Then
    PlugNumber = "Не найдено"
    Application.ThisCell.Font.Color = vbRed
Else
    PlugNumber = ExtWB.Worksheets(i).Range(ExtResult.Address).Offset(, 1).Value
    Application.ThisCell.Font.Color = vbBlack
    objExtwb.Close SaveChanges:=True
End If
End Function

происходит срабатывание процедуры Workbook_SheetChange и при выполнении условия вызывается процедура ChangeColor

ChangeColor

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub ChangeColor(ByVal Value As String)
Dim i As Integer
Dim ExtRange As Range, ExtResult As Range
Set ExtWb = GetObject(PathWB)
For i = 1 To ExtWb.Worksheets.Count
If ExtWb.Worksheets(i).FilterMode = True Then
ExtWb.Worksheets(i).ShowAllData
End If
Set ExtRange = ExtWb.Worksheets(i).UsedRange
Set ExtResult = ExtRange.Find(Value, , xlValues)
If Not ExtResult Is Nothing Then
Exit For
End If
Next
If Not ExtResult Is Nothing Then
    ExtWb.Worksheets(i).Range(ExtResult.Address).Offset(, 1).Interior.Color = RGB(0, 178, 80)
    ExtWb.Close SaveChanges:=True
End If
End Sub

Новые блоги и статьи Все статьи Все блоги /
Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Programma_Boinc 28.12.2025 Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / ********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / ********/ gallery/ bKBkQFf Пост отсюда. . .	Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .	Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .	PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.
Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .

@Devils 19 / 19 / 0 Регистрация: 05.02.2015 Сообщений: 175
	03.03.2017, 15:29 [ТС]
	Prisioner, пробовал - не помогает. 0

@Prisioner 6 / 6 / 3 Регистрация: 27.01.2017 Сообщений: 21
	03.03.2017, 15:38
	Devils, позволю себе задать уточняющий вопрос - цвет должен изменяться в "Другой книге" или в основной? 0

@Devils 19 / 19 / 0 Регистрация: 05.02.2015 Сообщений: 175
	03.03.2017, 15:39 [ТС]
	Prisioner, в "Другой книге" 0

toiai 3218 / 967 / 223 Регистрация: 29.05.2010 Сообщений: 2,087
	03.03.2017, 15:52
	Примера нет, а самому в лом, попробуйте использовать вместо Range -> Cells 0

@Vlad999 3946 / 2339 / 790 Регистрация: 02.11.2012 Сообщений: 6,214
	03.03.2017, 16:01
	я не спец, просто интересно. у процедуры три параметра, а передаете четыре - это нормально? 0

@Devils 19 / 19 / 0 Регистрация: 05.02.2015 Сообщений: 175
	03.03.2017, 16:05 [ТС]
	Vlad999, это я очепятался... торопился 4 параметра нет. Т.е. процедуре из функции передается 3 параметра и процедура принимает 3 параметра. 0

@Devils 19 / 19 / 0 Регистрация: 05.02.2015 Сообщений: 175
	03.03.2017, 17:04 [ТС]
	Prisioner, забавно, при подходе, который указан мной, ничего не портится (Сколько макросов так работает и проблем нет, кроме этого случая :-) ) Мне интересен именно вариант GetObject 0

@Hugo121 6997 / 2895 / 555 Регистрация: 19.10.2012 Сообщений: 8,803
	03.03.2017, 17:18
	Бывали случаи что какие-то файлы через GetObject не открывались, или открывались как-то криво, не выяснил с чем это было связано... 0

@Devils 19 / 19 / 0 Регистрация: 05.02.2015 Сообщений: 175
	06.03.2017, 10:28 [ТС]
	Че-то Workbooks.Open не хочет работать Данные в переменную ExtWB не записывает. 0