Доброго времени суток
Поставлена следующая задача: сделать так, чтобы все изменения автоматом фиксировались в другом файле XLS. Причины постановки неизвестны, идея, видимо, в том, что етсь некое центральное хранилище данных, в которое автоматом копируется информация из заполняемых накладных.
Решение состоит в создании нового объекта Application и открытии в нем файла-приемника. Далее в обработчике события OnSheetChange изменения и копируются.
Выглядит все вот таким образом:
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.
'эта переменная указывает на второе приложение Excel, в котором открыт файл-приемник данных
Private TargetApp As Application
Private Sub Workbook_Open()
Set TargetApp = Nothing
On Error GoTo ErrorHandler
'определимся с полным именем файла, в который будем писать
Dim destFullName As String
destFullName = ActiveWorkbook.path + "\destination.xls"
'создаем еще один объект-приложение Excel и в нем открываем файл-приемник
Set TargetApp = New Application
TargetApp.Visible = False
TargetApp.Workbooks.Open (destFullName)
Exit Sub
ErrorHandler:
s = "Проблема с файлом-приемником данных ('. " + fullName
s = s + "'). Код: " + Str(Err.Number)
s = s + ", описание: "
s = s + Err.Description
MsgBox s, vbCritical, "ЕГГОГ"
Set TargetApp = Nothing
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If TargetApp = Empty Or TargetApp Is Nothing Then
Exit Sub
End If
'сохраняем изменения в приемнике
TargetApp.Workbooks( 1 ).Save
'закрываем приложение-приемник
TargetApp.Quit
'Внимание. Если открыто два источника, связанные с одним и тем же приемником, то будут косяки
'как оно решается, я не в курсе. Текущая версия работает только в однопользовательском режиме
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal r As Range)
If TargetApp = Empty Or TargetApp Is Nothing Then
Exit Sub
End If
'приемник данных - приложение TargetApp.Workbooks(1).Sheets(1)
'в цикле установим новые значения ячеек приемника
'вообще-то, наверняка можно скопировать данные из [Range r] одним махом
'но хз как. А используемый метод медленный
For cellNum = 1 To r.Cells.Count
Col = r.Cells(cellNum).Column
Row = r.Cells(cellNum).Row
TargetApp.Workbooks( 1 ).Sheets( 1 ).Cells(Row, Col) = r.Cells(cellNum)
Next cellNum
End Sub
Два вопроса:
1. Каким образом можно скопировать Range измененых ячеек из источника в приемник одним махом, а не перебирая ячейки в цикле?
2. При закрытии файла-источника приемник закрывается автоматом. Если одновременно два источника связаны с одним приемником, возникают проблемы. Я так подозреваю, что Application, как СОМ-объект, должен предоставлять доступ к методу Release (или как его), который уменьшает счетчик ссылок. Метода такого, к сожалению, не нашел. Если же писать просто "Set TargetApp = Nothing", то приложение-приемник из памяти не выгружается. Второй вариант - можно ли как-то узнать, сколько ссылок имеется на данный момент у Application приемника? В этом случае приложение-источник при закрытии могло бы выяснять, связан ли приемник еще с кем-то, кроме данного источника и при отсутствии связей закрывать приемник.
