Добавление листов в workbook_open

У меня есть рабочий лист "StudentSheet1", который мне нужно добавить столько раз, сколько нужно пользователю.

Например, если пользователь вводит 3 в ячейку "A1", сохраняет его и закрывает книгу.

Я хочу иметь три листа: "StudentSheet1", "StudentSheet2" и "StudentSheet3", когда рабочая книга будет открыта в следующий раз.

Поэтому у меня будет код в событии Workbook_Open. Я знаю, как вставлять новые листы, но не могу вставить этот конкретный лист "StudentSheet1" три раза

Вот мой код:

Private Sub Workbook_Open() Application.ScreenUpdating = False Dim ws As Worksheet Set ws = ActiveWorkbook.Sheets.Add(Type:=xlWorksheet, After:=Worksheets(1)) Application.ScreenUpdating = True
End Sub
2 ответа

РЕДАКТИРОВАТЬ

Извините, я неправильно понял вопрос, попробуйте следующее:

Private Sub Workbook_Open() Dim iLoop As Integer Dim wbTemp As Workbook If Not Sheet1.Range("A1").value > 0 Then Exit Sub Application.ScreenUpdating = False Set wbTemp = Workbooks.Open(Filename:="//Ndrive/Student/Student.xlsm") wbTemp.Sheets("StudentSheet1").Copy After:=ThisWorkbook.Sheets(Sheets.Count) wbTemp.Close Set wbTemp = Nothing With Sheet1.Range("A1") For iLoop = 2 To .Value Sheets("StudentSheet1").Copy After:=ThisWorkbook.Sheets(Sheets.Count) ActiveSheet.Name = "StudentSheet" & iLoop Next iLoop .Value = 0 End With Application.ScreenUpdating = True
End Sub

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

РЕДАКТИРОВАТЬ В соответствии с комментариями @Sidd, если вам нужно проверить, существует ли лист, используйте эту функцию:

Function SheetExists(sName As String) As Boolean On Error Resume Next SheetExists = (Sheets(sName).Name = sName)
End Function


user793468, я бы порекомендовал другой подход. :)

wbTemp.Sheets("StudentSheet1").Copy After:=ThisWorkbook.Sheets(Sheets.Count)

не является надежным. См. Эту ссылку.

EDIT: приведенный выше код завершится неудачно, если в книге определены имена. В противном случае он абсолютно надежный. Благодаря Реафиди, чтобы поймать это.

Я просто заметил комментарий OP об общем диске. Добавление измененного кода для включения запроса OP.

Пробовал и тестировал

Option Explicit
Const FilePath As String = "//Ndrive/Student/Student.xlsm"
Private Sub Workbook_Open() Dim wb1 As Workbook, wb2 As Workbook Dim ws1 As Worksheet, ws2 As Worksheet Dim TempName As String, NewName As String Dim ShtNo As Long, i As Long On Error GoTo Whoa Application.ScreenUpdating = False Set wb1 = ActiveWorkbook Set ws1 = wb1.Sheets("Sheet1") ShtNo = ws1.Range("A1") If Not ShtNo > 0 Then Exit Sub Set wb2 = Workbooks.Open(FilePath) Set ws2 = wb2.Sheets("StudentSheet1") For i = 1 To ShtNo TempName = ActiveSheet.Name NewName = "StudentSheet" & i If Not SheetExists(NewName) Then ws2.Copy After:=wb1.Sheets(Sheets.Count) ActiveSheet.Name = NewName End If Next i '~~> I leave this at your discretion. ws1.Range("A1").ClearContents
LetsContinue: Application.ScreenUpdating = True On Error Resume Next wb2.Close savechanges:=False Set ws1 = Nothing Set ws2 = Nothing Set wb2 = Nothing Set wb1 = Nothing On Error GoTo 0 Exit Sub
Whoa: MsgBox Err.Description Resume LetsContinue
End Sub
'~~> Function to check if sheet exists
Function SheetExists(wst As String) As Boolean Dim oSheet As Worksheet On Error Resume Next Set oSheet = Sheets(wst) On Error GoTo 0 If Not oSheet Is Nothing Then SheetExists = True
End Function

licensed under cc by-sa 3.0 with attribution.