Заархивировать формулы нужного рабочего листа, и при необходимости, восстановить эти формулы — Visual Basic(Бейсик)

disel
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
Для того, чтобы создать "архив" формул нужного рабочего листа, можно сохранить формулы и адреса ячеек, которые содержат эти формулы, например, в текстовый файл. Для этого можно воспользоваться процедурой ExportFormulas, а для того, чтобы восстановить сохранённые формулы, достаточно всего лишь воспользоваться процедурой ImportFormulas.
 
Private Sub ExportFormulas()
    iFormulas$ = ThisWorkbook.Path & "\Formulas.txt"
    If Table.ProtectContents = True Then
       MsgBox "Рабочий лист защищён", _
       vbCritical, "Ошибка пользователя !!!"
       Exit Sub
    End If
    On Error GoTo ErrHandler
    Dim iSource As Range, iCell As Range
    Set iSource = Table.UsedRange.SpecialCells(xlFormulas)
  
    Open iFormulas$ For Output As #1
         For Each iCell In iSource
             Write #1, iCell.Address, iCell.Formula
         Next
    Close #1
ErrHandler:
    If Err.Number <> 0 Then
       MsgBox Err.Description, vbCritical, Err.Number
    End If
End Sub
  
Private Sub ImportFormulas()
    iFormulas$ = ThisWorkbook.Path & "\Formulas.txt"
    If Dir(iFormulas$) = "" Then
       MsgBox "Архивный файл изволит отсутствовать", _
       vbCritical, "Ошибка пользователя !!!"
       Exit Sub
    End If
    If Table.ProtectContents = True Then
       MsgBox "Рабочий лист защищён", _
       vbCritical, "Ошибка пользователя !!!"
       Exit Sub
    End If
    With Application
         .EnableCancelKey = xlDisabled
         .ScreenUpdating = False
         .DisplayAlerts = False
         .EnableEvents = False
         .Calculation = xlManual
         Open iFormulas$ For Input As #1
              Do While Not EOF(1)
                 Input #1, iAddress$, iFormula$
                 Table.Range(iAddress$) = iFormula$
              Loop
         Close #1
         If MsgBox("Вы хотите сохранить изменения ?", _
         vbYesNo, "") = vbYes Then ThisWorkbook.Save
         .Calculation = xlAutomatic
         .EnableEvents = True
         .DisplayAlerts = True
         .ScreenUpdating = True
         .EnableCancelKey = xlInterrupt
    End With
End Sub
Предполагается, что:
 
Table - это кодовое(программное) имя рабочего листа (см.пример), формулы которого необходимо сохранить. Использование именно кодового имени не носит обязательного характера, поэтому, Вы вправе использовать и другие варианты, например, имя листа или его индекс(номер).
 
Для экспорта и импорта формул необходимо, чтобы рабочий лист не был защищён, т.к. в противном случае, при экспорте, это может привести к тому, что скрытые формулы не будут заархивированы.
 
Данный пример не предназначен для работы с формулами массива и именованными формулами, однако, он позволит восстановить формулу и получить правильный результат вычислений, если именованная формула не была удалена и текст этой формулы не был изменён.

Похожие записи/страницы:

Leave a Comment