Как ограничить количество копий листа?

Question

Я хочу обновить приведенный ниже код и ограничить количество копий и переименований шаблона на основе ввода на вкладке «Ввод». Должно быть только 2 копии, и если кто-то попытается создать третье сообщение, всплывающее, например, «Вы можете создать только 2 вкладки». Существующий код выглядит следующим образом:

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

Sub scorecard()

    Dim A, B As String
    Dim lgn, col As Integer

    A = ActiveSheet.Cells(8, 5).Value & "_" & ActiveSheet.Cells(9, 5).Value
    B = ActiveSheet.Name

    On Error Resume Next
    Application.ScreenUpdating = False
    Sheets(A).Select

    If ActiveSheet.Name = A Then
        Sheets(B).Select
        Application.ScreenUpdating = True
        MsgBox ("This name already exists")
    Else

        Sheets("Template").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = A

Answer 1

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

Я бы подумал, что SheetActivate должно сработать.

Самый простой способ реализовать это - работать в вашем проекте под ThisWorkbook, который находится в папке объектов Microsoft Excel.

Здесь вы можете использовать объект Workbook в левом раскрывающемся списке, а затем выбрать событие SheetActivate в правом раскрывающемся списке.

---

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

Вот событие, и мы хотим передать ссылку Sh на нашу функцию.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    LimitNumberOfMatchingSheets Sh
End Sub

Вот функция, которую мы создаем, которая проверяет совпадение имени и макс.

Если он соответствует этим критериям, вы можете просто передать пользователю свое сообщение и удалить вновь созданный (или скопированный) лист.

Private Sub LimitNumberOfMatchingSheets(ByRef sheet As Worksheet)

    Const sheetName As String = "Sheet1"
    Const maxLimit As Long = 2

    'If name matches and max is reached then delete new worksheet
    If InStr(sheet.Name, sheetName) > 0 _
            And MatchingSheetNameCount(sheetName, ThisWorkbook) > maxLimit Then

        'I would put a better description here.
        MsgBox "This name already exists"

        'Disable the users ability to cancel the deletion.
        Application.DisplayAlerts = False
        sheet.Delete
        Application.DisplayAlerts = True
    End If
End Sub

Последняя вспомогательная функция, которая проверяет количество совпадающих имен листов.

Private Function MatchingSheetNameCount(ByVal likeName As String, ByVal book As Workbook) As Long

    Dim sheet As Worksheet
    For Each sheet In book.Worksheets
        If InStr(sheet.Name, likeName) > 0 Then
            MatchingSheetNameCount = MatchingSheetNameCount + 1
        End If
    Next sheet

End Function