Как перебрать именованные диапазоны - PullRequest
Новая
       18

Как перебрать именованные диапазоны

0 голосов
/ 26 июня 2019

У меня есть некоторый код, который импортирует файлы .bas, и мне нужно, чтобы он запускался через 2 именованных диапазона. Первый (MacroName) будет списком имен файлов (например, exam.bas, print.bas ...), а второй (ImportDate) будет датой импорта файла.

Приведенный ниже код циклически повторяется в папке, содержащей файлы .bas. Затем он проверяет дату изменения файла по именованному диапазону ImportDate. Но я не могу придумать способ зациклить именованные диапазоны 

For Each objFile In objFSO.GetFolder(szImportPath).Files
    If objFile.Name Like "*Import*" Then GoTo skipImport ' Skips the Import Module
    If (objFSO.GetExtensionName(objFile.Name) = "cls") Or _
        (objFSO.GetExtensionName(objFile.Name) = "frm") Or _
        (objFSO.GetExtensionName(objFile.Name) = "bas") And _
        objFile.DateLastModified > Range("ImportDate") Then

        Dim CurrentModuleName

        CurrentModuleName = Left(objFile.Name, (InStrRev(objFile.Name, ".", -1, vbTextCompare) - 1))
        '^ Gets the file name of the module being imported and removes the extension

        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent

        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents(CurrentModuleName)
        VBProj.VBComponents.Remove VBComp
        '^ Removes the module that is to be replaced

        Range("MacroName") = objFile.Name
        Range("ImportDate") = Format(Date, "dd/mm/yyyy") & " " & Format(Time, "hh.nn.ss")
        '^ Keep time as without, it will import the same module throughout the day when opened.

        cmpComponents.Import objFile.path
    End If      
skipImport:
Next objFile

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

1 Ответ

0 голосов
/ 26 июня 2019 
Sub test()
Dim r As Range
For Each r In ThisWorkbook.Names("MacroName").RefersToRange
    Debug.Print r.Address
Next r

End Sub
...