Создание функции L oop из повторяющейся строки кода

Question

Код ниже берет таблицу в Excel и вводит переменные из столбцов в текстовые поля в формате PDF. Это делается с помощью функции sendkeys снова и снова. Мне было интересно, есть ли простой способ сделать эту функцию зацикливанием в разделе кода sendkeys, так как я хотел бы иметь возможность добавлять намного больше столбцов / переменных при необходимости, без необходимости много копировать и вставлять этот код.

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

Спасибо за любую помощь!

Sub CreatePDFForms()
Dim PDFTemplateFile, NewPDFName, SavePDFFldr, Desc As String
Dim custRow, LastRow As Long

With Sheet1
LastRow = .Range("A999").End(xlUp).Row     'Last Row (just set it lower than the last data row)
PDFTemplateFile = .Range("F2").Value       'Template File Name, needs to be the same as the set cell above
SavePDFFldr = .Range("F4").Value           'Save PDF Folder, needs to be the same as well
ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.000004

    'CHANGE THE "LastRow" TO THE SAME NUMBER AS FIRST ROW TO TEST IF NEEDED

For CustRow = 13 To 13 ' LastRow
D1 = .Range("L" & CustRow).Value          'DEFINING THE VARIABLES AS "D##" WITH
D2 = .Range("B" & CustRow).Value          'REFERENCE TO SPECIFIC COLUMNS
D3 = .Range("AC" & CustRow).Value
D4 = .Range("C" & CustRow).Value
D5 = .Range("Y" & CustRow).Value
D6 = .Range("AB" & CustRow).Value
D7 = .Range("Z" & CustRow).Value
D8 = .Range("U" & CustRow).Value
'D9 = .Range("AA" & CustRow).Value
'D10 = .Range("AA" & CustRow).Value

Description = D4                        ' CHANGE THE D## IN THIS LINE TO THE DESCRIPTION VARIABLE FOR FILE NAME CREATION


    ' CHANGE THE "AA" TO THE ROW ASSOCIATED WITH THAT VARIABLE
    ' GET RID OF APOSTROPHE TO RELEASE FROM COMMENT LAYER

Application.SendKeys "{Tab}", True
Application.SendKeys D1, True
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys D2, True
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys D3, True
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys D4, True
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys D5, True
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys D6, True
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys D7, True
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys D8, True
Application.Wait Now + 0.00001

'Application.SendKeys "{Tab}", True
'Application.SendKeys D##, True
'Application.Wait Now + 0.00001

'Application.SendKeys "{Tab}", True
'Application.SendKeys D##, True
'Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys "{Esc}", True

Application.SendKeys "^(p)", True       ' opens the print menu
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00001
Application.SendKeys "{l}", True        ' change to a landscape orientation
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00001
Application.SendKeys "{Left}", True
Application.SendKeys "{Enter}", True



                                 ' *********************** BE SURE THAT PRINT TO PDF IS DEFAULT  *************************************



Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00001

    'CHANGE THE D## IN THE BELOW LINES TO CHANGE THE NAME OF THE FILE

If Dir(SavePDFFldr & "\" & Description & ".pdf") <> Empty Then Kill (SavePDFFldr & "\" & Description & ".pdf")

    ' THE ABOVE CODE DELETES A FILE WITH THE SAME NAME IN THE FOLDER
    ' IF YOU WANT TO KEEP OLD COPIES, SAVE TO A DIFFERENT FOLDER OR MOVE THE OLDER DRAFTS

Application.SendKeys SavePDFFldr & "\" & Description & ".pdf"
Application.Wait Now + 0.00001

Application.SendKeys "%(s)"
Application.Wait Now + 0.00001

Next custRow

    ' THE FOLLOWING CODE CLOSES THE PROGRAM AND FOLDERS

Application.SendKeys "^(q)", True
Application.SendKeys "{numlock}%s", True
Application.SendKeys "{Tab}", True
Application.SendKeys "{Enter}", True

End With
End Sub

Answer 1

Я думаю, что это отвечает на вопрос, который вы подразумевали ...

Option Explicit

Sub SendResponses()
    Dim ws As Worksheet
    Set ws = Sheet1

    Dim dataColumns As Variant
    dataColumns = Split("L,B,AC,C,Y,AB,Z,U,AA", ",")

    Dim custRow As Long
    For custRow = 13 To 13
        Dim dataItem As Variant
        For Each dataItem In dataColumns
            SendData ws, custRow, dataItem
        Next dataItem
    Next custRow 
End Sub

Private Sub SendData(ByRef ws As Worksheet, _
                     ByVal thisRow As Variant, _
                     ByVal thisColumn As Variant)
    Application.SendKeys "{Tab}", True
    Application.SendKeys ws.Cells(thisRow, thisColumn).Value, True
    Application.Wait Now + 0.00001
End Sub