Принудительное обновление / загрузка именованных диапазонов в книге, открытой в Excel

Question

У меня есть много именованных диапазонов, которые берутся из метаданных нашей системы управления файлами.Обычно при открытии рабочей книги требуется некоторое время (до 5 секунд) для загрузки этих значений в ячейки.У меня есть некоторые другие процессы, связанные с этими клетками.Например, показывать / скрывать фигуры, если, скажем, ячейка A1> 1. Проблема в том, что теперь нет кода для идентификации, эти значения уже загружены, так что можно выполнить другой код.

Вопрос: Есть ли способ принудительно загрузить значения именованных диапазонов с помощью VBA?Или убедитесь, что они загружены?

Вот так выглядит Name Manager (все эти = "" заполняются значениями в Workbook_Open):

Вот мой текущий код:

Private Sub Workbook_Open()

On Error Resume Next

'Application.Visible = False

    Loading.LabelProgresso.Width = 0
    Loading.Show (vbModeless)

    oFractionComplete (0)

        ThisWorkbook.Worksheets("MAIN").ScrollArea = "$A$1:$BL$45"

    oFractionComplete (0.1)

    'ENSURE NAMED RANGES ARE LOADED (CODE HERE)

        DoEvents

            If ThisWorkbook.Sheets("Price calculation").Range("G1866") > 500000 And _
                ThisWorkbook.Sheets("Other Data").Range("U7") = "value" Or _
                ThisWorkbook.Sheets("Other Data").Range("T31") > 500000 Then
                ThisWorkbook.Sheets("MAIN").Shapes("LimitRequest").Visible = True
                ThisWorkbook.Sheets("MAIN").Shapes("CreditCheck").Visible = False
            Else
                ThisWorkbook.Sheets("MAIN").Shapes("LimitRequest").Visible = False
                ThisWorkbook.Sheets("MAIN").Shapes("CreditCheck").Visible = True
            End If

    oFractionComplete (0.2)
    ........

Answer 1

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

Sub CreateNRandCountBlank()

'~~~> Assign the data types for the variables.
Dim wb As Workbook
Dim ws As Worksheet
Dim strNamedRange As String
Dim rngNamedRange As Range
Dim iBlanks As Long
Dim iZeros As Long
Dim iErrors As Long
Dim rngErrors As Range


'~~~> Assign objects to variables.
Set wb = ThisWorkbook

'~~~> Name of the named range to be created.
strNamedRange = "RangeOfNR"

'~~~> The worksheet that contains the range.
Set ws = wb.Worksheets("Named Ranges")

'~~~> Assign a range of cells to the named range.
Set rngNamedRange = ws.Range("A1:A100")

'~~~> If the specified named range currently exist...
If RangeNameExists(strNamedRange) = True Then

    '~~~> Delete it.
    wb.Names(strNamedRange).Delete

End If

    '~~~> Create the specified named range.
    wb.Names.Add Name:=strNamedRange, RefersTo:=rngNamedRange

    '~~~> Count the cells in the range that have blank values.
    iBlanks = WorksheetFunction.CountBlank(Range(strNamedRange))
    Debug.Print "iBlanks " & iBlanks

    '~~~> Count the cells in the range that have values equal to 0.
    iZeros = WorksheetFunction.CountIf(Range(strNamedRange), 0)
    Debug.Print "iZeros " & iZeros

    '~~~> Count the cells in the range that contain errors.
    On Error Resume Next

    Set rngErrors = ws.Range(strNamedRange).SpecialCells(xlFormulas, xlErrors)

    On Error GoTo 0

    If Not rngErrors Is Nothing Then

        iErrors = rngErrors.Cells.Count

    Else

        iErrors = 0

    End If

    Debug.Print "iErrors " & iErrors

    '~~~> Action goes here.
    MsgBox _
        iBlanks & " Blanks" & vbNewLine & _
        iZeros & " Zeros" & vbNewLine & _
        iErrors & " Errors", vbOKOnly, "Range Analysis"

'~~~> Release the variables from memory.
Set wb = Nothing
Set ws = Nothing
Set rngNamedRange = Nothing
Set rngErrors = Nothing
iBlanks = vbNull
iZeros = vbNull
iErrors = vbNull
strNamedRange = vbNullString

End Sub


Private Function RangeNameExists(rngName) As Boolean

Dim n As Name

    RangeNameExists = False

    For Each n In ActiveWorkbook.Names

        If UCase(n.Name) = UCase(rngName) Then

            RangeNameExists = True

            Exit Function

        End If

    Next n

End Function