Рабочий лист - активировать код для новых листов - PullRequest
2 голосов
/ 22 января 2010

У меня три вопроса о VBA и управлении / манипулировании новыми окнами.

У меня настроено несколько листов.

Мастер | Рабочий лист1 | Рабочий лист2 | Примечания Заказы на работы | Контактная информация

1) У меня есть функции WorkSheet_Activate, настроенные для Notes, рабочих заданий, контактной информации, которые открывают все три листа в отдельных окнах и располагают их вертикально.

Private Sub WorkSheet_Activate()

    ActiveWindow.NewWindow
    ActiveWindow.NewWindow
    Windows.Arrange ArrangeStyle:=xlVertical
    Sheets("Notes").Select
    Windows("Mastersheet.xlsm:2").Activate
    Sheets("Work Orders").Select
    Windows("Mastersheet.xlsm:1").Activate
    Sheets("Contact Info").Select

End Sub

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

2) Теперь, когда я перехожу на другой лист, такой как Мастер, я бы хотел, чтобы дополнительные окна закрылись и чтобы Мастер лист был активным. Я использовал следующий код на мастер-листе.

Private Sub WorkSheet_Activate()


    Windows("Mastersheet.xlsm:2").Activate
    ActiveWindow.Close
    Windows("Mastersheet.xlsm:1").Activate
    ActiveWindow.Close
    ActiveWindow.WindowState = xlMaximized

End Sub

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

3) Последняя проблема состоит в том, что в рабочей книге динамически создаются новые листы с помощью макросов. Эти новые рабочие листы не будут содержать вышеуказанный код, который закрывает несколько окон и фокусируется на активном листе. Есть ли другой объект, в который я должен поместить код, чтобы он применим к Master | Рабочий лист1 | Рабочий лист 2 листа и любые новые листы?

Ответы [ 2 ]

5 голосов
/ 22 января 2010

Это много вопросов. :) Для 3 вам нужно переместить ваши события из того места, где они есть, в специальный модуль класса, который обрабатывает события уровня приложения. Начните с вставки нового модуля класса в ваш проект (Вставка - Модуль класса). Назовите этот модуль CAppEvents (F4, чтобы показать страницу свойств, где вы можете изменить имя). Затем вставьте этот код в модуль класса

Option Explicit

Private WithEvents mobjWb As Workbook

Private Sub Class_Terminate()

    Set mobjWb = Nothing

End Sub

Public Property Get wb() As Workbook

    Set wb = mobjWb

End Property

Public Property Set wb(objwb As Workbook)

    Set mobjWb = objwb

End Property

Private Sub mobjWb_SheetActivate(ByVal Sh As Object)

    Dim wn As Window

    If IsSplitSheet(Sh) Then
        If Not IsSplit(Sh) Then
            CreateSplitSheets Sh
        End If
    Else
        If IsSplit(Sh) Then
            For Each wn In Me.wb.Windows
                If wn.Caption Like Me.wb.Name & ":#" Then
                    wn.Close
                End If
            Next wn
            ActiveWindow.WindowState = xlMaximized
            Sh.Activate
        End If
    End If

End Sub

Private Function IsSplitSheet(Sh As Object) As Boolean

    Dim vaNames As Variant
    Dim i As Long

    IsSplitSheet = False
    vaNames = GetSplitSheetNames

    For i = LBound(vaNames) To UBound(vaNames)
        If vaNames(i) = Sh.Name Then
            IsSplitSheet = True
            Exit For
        End If
    Next i

End Function

Private Function IsSplit(Sh As Object) As Boolean

    Dim wn As Window

    IsSplit = False

    For Each wn In Me.wb.Windows
        If wn.Caption Like Sh.Parent.Name & ":#" Then
            IsSplit = True
            Exit For
        End If
    Next wn

End Function

Private Sub CreateSplitSheets(Sh As Object)

    Dim vaNames As Variant
    Dim i As Long
    Dim wn As Window
    Dim wnActive As Window

    vaNames = GetSplitSheetNames
    Set wnActive = ActiveWindow

    For i = LBound(vaNames) To UBound(vaNames)
        If vaNames(i) <> Sh.Name Then
            Set wn = Me.wb.NewWindow
            wn.Activate
            On Error Resume Next
                wn.Parent.Sheets(vaNames(i)).Activate
            On Error GoTo 0
        End If
    Next i

    Sh.Parent.Windows.Arrange xlVertical
    wnActive.Activate
    Sh.Activate

End Sub

Private Function GetSplitSheetNames() As Variant

    GetSplitSheetNames = Array("Notes", "Work Orders", "Contact Info")

End Function

Затем вставьте стандартный модуль (Вставка - Модуль) и вставьте этот код

Option Explicit

Public gclsAppEvents As CAppEvents

Sub Auto_Open()

    Set gclsAppEvents = New CAppEvents
    Set gclsAppEvents.wb = ThisWorkbook

End Sub

Вот что происходит: когда вы открываете книгу, Auto_Open запустится и создаст новый экземпляр вашего объекта CAppEvents. Так как gclsAppEvents является общедоступным (он же глобальный), он не потеряет возможности до тех пор, пока рабочая книга открыта. Он будет сидеть и слушать события (потому что мы использовали ключевое слово WithEvents в классе).

В классе есть подпрограмма с именем mobjWb_SheetActivate. Это то, что срабатывает всякий раз, когда активируется какой-либо лист в этой книге. Сначала он проверяет, является ли лист, который вы только что активировали (переменная Sh), одним из тех, которые вы хотите разделить (используя IsSplitSheet). Если это так, то он проверяет, был ли он уже разделен. Если нет, то это разделяет их.

Если Sh (лист, который вы только что активировали) не является одним из «разделенных листов», то он проверяет, было ли выполнено разделение (IsSplit). Если он есть, он закрывает все разделенные окна.

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

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

1 голос
/ 22 января 2010

1) Чтобы проверить, открыто ли уже окно, используйте эту функцию

Function IsWindowOpen(windowTitle As String) As Boolean
    Dim i As Long
    For i = 1 To Windows.Count
        If Windows(i).Caption = windowTitle Then
            IsWindowOpen = True
            Exit Function
        End If
    Next
    IsWindowOpen = False
End Function

Например:

if not IsWindowOpen("Mastersheet.xlsm:2") then
     ' code to open windows
end if

2) Вы можете снова использовать функцию, та же идея:

if IsWindowOpen("Mastersheet.xlsm:2") then
     ' code to close windows
end if

3) Добавьте свой код в модуль, а не на лист. Затем вызовите подпрограмму из макроса, который добавляет новые листы после того, как это сделано. Если этот макрос находится в другом модуле, возможно, вам необходимо убедиться, что ваш Sub общедоступен.

...