Объект не поддерживает это свойство или метод: Workbooks.Worksheets.Range

Question

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

Sub TextColor()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet

Application.ScreenUpdating = False

Set wb1 = Workbooks("File 1.xlsm")
Set wb2 = Workbooks("File 2.xlsm")
Set ws1 = Worksheets("Sheet 1")

wb2.Worksheets("Destination Sheet").Range("G4").Interior.Color = wb1.ws1.Range("D19").Interior.Color

Answer 1

Объект 'ws1' создается отдельно и, хотя переменная является дочерним объектом 'wb1', сама переменная не является ее дочерним объектом, а только ссылкой на него. Допустимые стили ссылок:

ws1
wb1.Worksheets("Sheet1")

Кроме того, когда вы устанавливаете 'ws1', вы должны ссылаться на родительскую книгу в этой строке. Это изменит вашу строку 'ws1' следующим образом:

Set ws1 = wb1.Worksheets("Sheet1")

С этого момента вам нужно только ссылаться на 'ws1' в качестве объекта.

В качестве примечания при работе с другие рабочие книги, я рекомендую проверить, существует ли рабочая таблица или нет. Если вы жестко запрограммировали имя, а оно не существует, его изменили или вы допустили ошибку при вводе, это может привести к ошибке. Ниже приведена функция, которую вы можете использовать для проверки существования или отсутствия рабочего листа.

Function WorksheetExists( _
         ByVal SheetName As String, _
         Optional TargetBook As Workbook _
         ) As Boolean

    If TargetBook Is Nothing Then
        If ActiveWorkbook Is Nothing Then Exit Function
        Set TargetBook = ActiveWorkbook
    End If
    On Error Resume Next
    WorksheetExists = CBool(Len(TargetBook.Worksheets(SheetName).Name) <> 0)
    On Error GoTo 0

End Function

Те же логики c применяются, если вы ищете книгу и вам необходимо знать, существует ли она, хотя функция для него будет немного другой, как показано в приведенном ниже коде.

Public Function ExistingFile( _
       ByVal FilePath As String _
       ) As Boolean

    Dim Attributes As Integer

    On Error Resume Next
    Attributes = GetAttr(FilePath)
    ExistingFile = (Err.Number = 0) And (Attributes And vbDirectory) = 0
    Err.Clear

End Function

Обратите внимание, что приведенная выше функция может вызвать ошибку, если имя файла слишком длинное.