Добавить страницу в указанном c месте на листе - PullRequest
0 голосов
/ 26 февраля 2020

У меня есть рабочий лист под названием «План управления» с 3 страницами информации. Код ниже (я не создавал, но манипулировал им на протяжении многих лет) копирует содержимое второй страницы и перемещает ее в следующую пустую строку снизу. Затем он вставляет скопированные данные, чтобы создать новую страницу. Содержимое очищается из указанного диапазона c для ввода новых данных. Процесс повторяется при добавлении новых листов.

Мне нужно, чтобы страница 3 всегда перемещалась и была последней страницей листа, независимо от того, сколько раз пользователь добавляет страницы. Документ увеличивается динамически, когда пользователь нажимает кнопку «Добавить контрольный список» на странице 2, которая теперь становится страницей 3 и так далее. Содержимое на текущей странице 3 должно быть перемещено и всегда быть новой последней страницей каждый раз.

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

Option Explicit

Sub ResetLastCellPrim()
  ActiveSheet.UsedRange
End Sub

Sub AddAnotherChecklist()
  Dim Source As Range, Dest As Range
  Dim OOold As OLEObject, OOnew As OLEObject
  Dim OOs As New Collection
  'Screen off runs faster
  Application.ScreenUpdating = False
  'Refer to the sheet
  With Sheets("Control Plan")
    .Unprotect "bdh"
    'These cells contain the template
    Set Source = .Rows("40:72")
    'Find the next empty cells from the bottom
    Set Dest = .Range("A" & Rows.Count).End(xlUp).Offset(1)
    'Copy them
    Source.Copy Dest
    'Find all ActiveX controls in Source
    For Each OOold In .OLEObjects
      'Inside Source?
      If Not Intersect(Source, OOold.TopLeftCell) Is Nothing Then
        'Remember this one
        OOs.Add OOold
      End If
    Next
    'Now copy all collected controls
    For Each OOold In OOs
      'Copy and paste anywhere
      OOold.Copy
      .Paste
      'Refer to the pasted control
      Set OOnew = .OLEObjects(.OLEObjects.Count)
      'Move it to the right place
      OOnew.Left = OOold.Left
      OOnew.Top = OOold.Top + Dest.Top - Source.Top
      'Clear the contents
      Select Case OOnew.progID
        Case "Forms.ComboBox.1"
          OOnew.Object.ListIndex = -1
      End Select
    Next
    'Go to the 1st input cell
    .Select
    ActiveWindow.ScrollRow = Dest.Row
    Dest.Offset(5).Select
    'Clear the contents
    Dest.Offset(4).Resize(21).EntireRow.ClearContents
    .Protect "bdh"
  End With
End Sub

Вот ссылка на файл Excel https://1drv.ms/x/s! AhhCUWS6u9Vkgs8qHKLsuHNJn5Spfw? e = KXqdUh

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