Ссылка на несколько «шаблонных» листов в VBA - PullRequest
0 голосов
/ 25 апреля 2018

В настоящее время у меня есть код VBA (ниже), который проходит через мой первый лист (Счета) и создает отдельные листы на основе номера счета.На данный момент он использует шаблон из листа «Шаблон».

Я хотел бы иметь возможность:

Во-первых - выбрать, использовать ли «Шаблон» или «Шаблон найма» (в зависимости от того, является ли счет-фактура стандартным или счет-фактура по найму), основанный на значении ячейки в моем листе счетов-фактур (возможно, столбец под названием «Нанимать», где значением является y или n).

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

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

Другая вещь, которую он делает, - это создание некоторых ячеек с гиперссылками для облегчения навигации по Рабочей книге (может быть до 100+ листов), но я доволен тем, как они работают в этом примере.

Кроме того, изменение размера столбцов и рядов - это своего рода обман, чтобы привести в порядок вещи.Есть ли более точный способ ссылаться на это из листов шаблона (или шаблона найма) соответственно?

Пожалуйста, дайте мне знать, если есть что-то, что я могу прояснить, или любую дополнительную информацию, которую я могу предоставить, чтобы помочь вам помочь мне!

Заранее благодарим за помощь!

Рис

Sub AddNamedSheets()
Dim srcName, dstName As Range
Dim invoicesSheet As Worksheet
Dim templateSheet As Worksheet
Dim NewSheet As Worksheet
Dim myBook As Workbook
Dim lastRow As Long
Dim i As Long
Dim namesColumn


'Define your workbook - here set as the active workbook
Set myBook = ActiveWorkbook

'Define your worksheets - The sheets are named "Invoices" and "Template" respectively
Set invoicesSheet = myBook.Worksheets("Invoices")
Set templateSheet = myBook.Worksheets("Template")

'Define which column in your master tab the list is - here it's B i.e. column 2
namesColumn = 2

'Find the last row of the sheets list
lastRow = invoicesSheet.Cells(invoicesSheet.Rows.Count, namesColumn).End(xlUp).Row


'Cycle through the list - Assuming the list starts in column "A" from the 2nd row
For i = 2 To lastRow

'Create Worksheets and Copy Row
  Set srcName = Sheets("Invoices").Range("A" & i)
     ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
     ActiveSheet.Name = srcName
       srcName.Range("A" & 1).Copy Destination:=ActiveSheet.Range("J3")
'Create Hyperlink to new sheet
         srcName.Hyperlinks.Add Anchor:=srcName, _
             Address:="", SubAddress:=srcName & "!J3", _
             TextToDisplay:=srcName.Value
'Create HyperLink back to Main sheet
  Set dstName = ActiveSheet.Range("J3")
         dstName.Hyperlinks.Add Anchor:=dstName, _
             Address:="", SubAddress:="'Invoices'!A1", _
             TextToDisplay:=dstName.Value
'Copy data from template
Worksheets("Template").Range("A1:J46").Copy _
    Destination:=ActiveSheet.Range("A1")

Rows("1").RowHeight = 110
Rows("2").RowHeight = 30
Rows("3:6").RowHeight = 21
Rows("7:34").RowHeight = 20
Rows("35:44").RowHeight = 21
Rows("45:46").RowHeight = 16

Columns("A").ColumnWidth = 10
Columns("B").ColumnWidth = 15
Columns("C").ColumnWidth = 17.5
Columns("D").ColumnWidth = 20
Columns("E").ColumnWidth = 10
Columns("F").ColumnWidth = 10
Columns("G").ColumnWidth = 10
Columns("H").ColumnWidth = 15



  Next
End Sub

1 Ответ

0 голосов
/ 25 апреля 2018

Не проверено, но что-то вроде:

Sub AddNamedSheets()

    Dim srcName, dstName As Range
    Dim invoicesSheet As Worksheet
    Dim templateSheet
    Dim NewSheet As Worksheet
    Dim myBook As Workbook
    Dim lastRow As Long
    Dim i As Long
    Dim namesColumn

    Set myBook = ActiveWorkbook

    Set invoicesSheet = myBook.Worksheets("Invoices")

    'Define which column in your master tab the list is - here it's B i.e. column 2
    namesColumn = 2

    'Find the last row of the sheets list
    lastRow = invoicesSheet.Cells(invoicesSheet.Rows.Count, namesColumn).End(xlUp).Row

    'Cycle through the list - Assuming the list starts in column "A" from the 2nd row
    For i = 2 To lastRow

        'which template to copy? keys off ColJ here for example
        If LCase(invoicesSheet.Cells(i, 10).Value) = "y" Then
            Set templateSheet = myBook.Worksheets("Hire Template")
        Else
            Set templateSheet = myBook.Worksheets("Template")
        End If

        'copy the template and rename it
        templateSheet.Copy after:=myBook.Worksheets(myBook.Worksheets.Count)
        Set NewSheet = myBook.Worksheets(myBook.Worksheets.Count)
        NewSheet.Name = srcName.Value

        Set srcName = invoicesSheet.Range("A" & i)
        srcName.Copy Destination:=NewSheet.Range("J3")
        Set dstName = NewSheet.Range("J3")

        'Create Hyperlink to new sheet
        srcName.Hyperlinks.Add Anchor:=srcName, _
            Address:="", SubAddress:=srcName & "!J3", _
            TextToDisplay:=srcName.Value

        'Create HyperLink back to Main sheet
        dstName.Hyperlinks.Add Anchor:=dstName, _
            Address:="", SubAddress:="'Invoices'!A1", _
            TextToDisplay:=dstName.Value

    Next i

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