Page break issues when exporting to pdf from userform (VBA)

[auglocqnuk]

Background: I am trying to create a front-end form that can be filled out by a user, which will then populate a back-end spreadsheet the user cannot edit. This spreadsheet needs to follow a standard layout that I have already created, and the form will populate predetermined cells (or will create cells following the layout) based on user input from the form. I also need the form to be able to add/repeat questions, as well as duplicate sections in the spreadsheet based on user input requirements ("Do you need to add a section? [Yes/No]" //If [Yes], then duplicate section, repeat questions in form; if [No], then export data to spreadsheet, exit form). The spreadsheet layout consists of sections. The number of sections/cells per section required will vary from user to user, but the type of data will typically remain the same, and therefore should be able to choose the name of the field from a list of some sort (drop down?) However, the user may need to create a custom name for a field. I also need the form to be able to automatically adjust cell sizes based on the amount of text for that value. It is important that this form is printable, and does not separate sections from page to page. Furthermore, each "Notes" field will vary in size, and should be automatically resized to only show the existing text, plus one blank line for hand-written notes. I would also like the form to prompt the user to indicate whether a field is needed (some fields will be permanent, and the user will not be prompted about these fields). If the field is not needed, I need the form to exclude it from the final output.

I am open to suggestions on how to design this project differently than I have already (for example, using alternate programs/software/coding languages/techniques).

Current Issue: So far, however, I have (with assistance) created a user form in Excel that collects data and inputs it into a spreadsheet, which can then be exported to a PDF report using a set format/layout on another sheet of the workbook. The layout consists of a "Header" section and an "Item" section. In the form, the user can input a single job number and multiple item numbers, and when they export the report, the code prints the job number in the provided layout for the header, and then loops through the item numbers and copies and populates the item section for as many items as the user has provided. In the exported PDF, however, the item section gets split between pages, regardless of page orientation (landscape orientation is preferred). How do I prevent the "Item" section from being broken up between pages?

Option Explicit
Dim ctl As Control
Dim rCell As Range
Dim img As Picture
Dim newrow As ListRow
Dim tbl1 As ListObject
Dim msgValue As VbMsgBoxResult
Dim ary As Variant, aryx As Variant
Dim ws2 As Worksheet, ws1 As Worksheet
Dim s As String, FilePath As String, user As String, pFilename As String, part As String
Dim x As Long, sc As Long, j As Long, ctr As Long, rctr As Long, tbl1row As Long, r As Long, t As Long, items As Long, y As Long, ctrx As Long

Private Sub cmdCLEAR_Click()
MsgBox ("This action only clears the form NOT the record" & vbCrLf & "Ready for adding NEW entry."), vbOKOnly, "Clear Form "
CLEARFORM
Me.cmdADD.Enabled = True
Me.TextBox6.SetFocus
End Sub

Sub CLEARFORM()
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "ComboBox"
ctl.ListIndex = -1
ctl.Value = ""
End Select
Next ctl
Me.Image1.Picture = LoadPicture("") '*********clears picture******
End Sub

Private Sub cmdADD_Click()
For x = 1 To 35
If Controls("TextBox" & x).Text = "" Then
MsgBox "Data field missing", vbCritical, "Data missing"
Exit Sub
End If
Next x
msgValue = MsgBox("Do want to add another item?", vbYesNo + vbQuestion, "Next Item ?")
If msgValue = vbYes Then
SAVEDATANEXT
For x = 16 To 35
Me.Controls("TextBox" & x).Text = ""
Next x
Me.TextBox6.SetFocus
Exit Sub
End If
SAVEDATA
LOADLIST
LOADCOMBO1
End Sub

Sub SAVEDATANEXT()
Set newrow = tbl1.ListRows.Add
With newrow
For x = 1 To 35
.Range(x) = Me.Controls("TextBox" & x).Text '***************textbox35 contains picture filepath ***********
Next x
.Range(36) = tbl1.ListRows.Count '*********this is important row counter saves the need for search routines***********
End With
End Sub

Sub SAVEDATA()
Set newrow = tbl1.ListRows.Add
With newrow
For x = 1 To 35
.Range(x) = Me.Controls("TextBox" & x).Text '***************textbox35 contains picture filepath ***********
Next x
.Range(36) = tbl1.ListRows.Count '*********this is important row counter saves the need for search routines***********
End With
CLEARFORM
LOADLIST
End Sub

Sub LOADLIST()
Set ws2 = Sheet2
Set tbl1 = ws2.ListObjects("Table1")
With tbl1
If .DataBodyRange.Cells(1, 1) = vbNullString Then Exit Sub
ary = .DataBodyRange
End With
Me.ListBox1.List = ary
End Sub

[COLOR=rgb(235, 107, 86)]Private Sub cmdPRINT_Click()
If Me.ComboBox1.Value = vbNullString Then
MsgBox "A PDF cannot be created because no Part # selected.", , "No Part# selected."
Exit Sub
End If
With Sheet3
.Range("A28:O10000").Clear
.Range("D2:D10").Value = ""
.Range("J2:J8").Value = ""
.Range("B17:N17").Value = ""
.Range("B19:N19").Value = ""
.Range("B21:N21").Value = ""
.Range("D23").Value = ""
For Each img In Sheet3.Pictures: img.Delete: Next img  '**********clears pictures prior to building new PDF********
ctr = 28
For x = 1 To items - 2
.Range("A15:O26").Copy .Range("A" & ctr)
ctr = ctr + 13
Next x
For y = 2 To 8
.Range("D" & y).Value = Me.ListBox1.List(0, y - 2)
.Range("J" & y).Value = Me.ListBox1.List(0, y - 2 + 7)
.Range("D10").Value = Me.ListBox1.List(0, 14)
Next y
ctr = 0
ctrx = 0
For x = 1 To items - 1
.Cells(17 + ctr, 2).Value = Me.ListBox1.List(ctrx, 15)
.Cells(17 + ctr, 4).Value = Me.ListBox1.List(ctrx, 16)
.Cells(17 + ctr, 6).Value = Me.ListBox1.List(ctrx, 17)
.Cells(17 + ctr, 8).Value = Me.ListBox1.List(ctrx, 18)
.Cells(17 + ctr, 10).Value = Me.ListBox1.List(ctrx, 19)
.Cells(17 + ctr, 12).Value = Me.ListBox1.List(ctrx, 20)
.Cells(17 + ctr, 14).Value = Me.ListBox1.List(ctrx, 21)
.Cells(19 + ctr, 2).Value = Me.ListBox1.List(ctrx, 22)
.Cells(19 + ctr, 4).Value = Me.ListBox1.List(ctrx, 23)
.Cells(19 + ctr, 6).Value = Me.ListBox1.List(ctrx, 24)
.Cells(19 + ctr, 8).Value = Me.ListBox1.List(ctrx, 25)
.Cells(19 + ctr, 10).Value = Me.ListBox1.List(ctrx, 26)
.Cells(19 + ctr, 12).Value = Me.ListBox1.List(ctrx, 27)
.Cells(21 + ctr, 2).Value = Me.ListBox1.List(ctrx, 28)
.Cells(21 + ctr, 6).Value = Me.ListBox1.List(ctrx, 29)
.Cells(21 + ctr, 8).Value = Me.ListBox1.List(ctrx, 30)
.Cells(21 + ctr, 12).Value = Me.ListBox1.List(ctrx, 31)
.Cells(21 + ctr, 14).Value = Me.ListBox1.List(ctrx, 32)
.Cells(23 + ctr, 4).Value = Me.ListBox1.List(ctrx, 33)
'**************************************inserting picture into PDF loader*****************
pFilename = Me.ListBox1.List(ctrx, 34)
If pFilename = "" Then GoTo Err:
Set img = .Pictures.Insert(pFilename)
With img
.Left = Sheet3.Cells(23 + ctr, 14).Left
.Top = Sheet3.Cells(23 + ctr, 14).Top
.Width = 16
.Height = 44.25
.Placement = 1
.PrintObject = True
End With
Err:
'***************************************************************************************
ctrx = ctrx + 1
ctr = ctr + 13
Next x
End With
user = Environ("Username")
FilePath = "C:\Users\" & user & "\Desktop\"
ThisWorkbook.Worksheets("Sheet3").Select
part = Sheet3.Cells(2, 4)
Application.ScreenUpdating = True
'*****************set print area and orientaton********************
Application.PrintCommunication = False
With ActiveSheet.PageSetup
    .Orientation = xlLandscape
    .PrintArea = Sheet3.Range(Sheet3.Cells(1, 1), Sheet3.Cells(ctr, 15))
    .Zoom = False
    .FitToPagesTall = False
    .FitToPagesWide = 1
    .PaperSize = xlPaperLetter
    '****Update on 11/7/22****
    '.TopMargin = Application.InchesToPoints(0.31)
    '.BottomMargin = Application.InchesToPoints(0.31)
    '*************************
End With
Application.PrintCommunication = True
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath & "\Part# " & part, OpenAfterPublish:=False, IgnorePrintAreas:=False
'*********************************************************************
Application.ScreenUpdating = True
MsgBox "Data has been exported to PDF on Desktop."
With Sheet3
.Range("A28:O10000").Clear
.Range("D2:D10").Value = ""
.Range("J2:J8").Value = ""
.Range("B17:N17").Value = ""
.Range("B19:N19").Value = ""
.Range("B21:N21").Value = ""
.Range("D23").Value = ""
For Each img In Sheet3.Pictures: img.Delete: Next img  '**********clears pictures ready to build new PDF********
End With
End Sub[/COLOR]

'********************************open file dialog box to get picture location******************
Private Sub cmdGETPHOTO_Click()
On Error Resume Next
pFilename = Application.GetOpenFilename(FileFilter:="Jpg Files (*.jpg), *.jpg", Title:="SELECT TOOL PHOTO")
Me.Image1.Picture = LoadPicture(pFilename)
Me.TextBox35.Text = pFilename
End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub Frame1_Click()

End Sub

Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If Me.ListBox1.ListIndex = -1 Then Exit Sub
If Me.ListBox1.ListIndex > -1 Then sc = Me.ListBox1.ListIndex
With Me.ListBox1
For x = 1 To 35
Me.Controls("TextBox" & x).Value = .List(sc, x - 1)
Next x
tbl1row = .List(sc, 35)
End With
On Error GoTo Err
Me.Image1.Picture = LoadPicture(Me.TextBox35.Text) 'retrieves picture file location************
Exit Sub
Err: Me.Image1.Picture = LoadPicture("")
End Sub

Private Sub cmdDELETE_Click()
If Me.ListBox1.ListIndex < 0 Then
MsgBox "No Record selected", , "Errors"
Exit Sub
End If
msgValue = MsgBox("ARE YOU CERTAIN YOU WISH TO REMOVE RECORD?", vbCritical + vbYesNo + vbDefaultButton2, "Remove Record")
If msgValue = vbNo Then
CLEARFORM
Exit Sub
End If
tbl1.ListRows(tbl1row).Delete
CLEARFORM
LOADLIST
LOADCOMBO1
MsgBox ("RECORD REMOVED"), vbOKOnly + vbInformation, "Record Removed"
End Sub

Private Sub cmdUPDATE_Click()
If Me.ListBox1.ListIndex < 0 Then
MsgBox "No Record selected", , "Errors"
Exit Sub
End If
With tbl1
For x = 1 To 35
.Range(tbl1row + 1, x) = Me.Controls("TextBox" & x).Text '*********textbox35 contains picture filepath **********
Next x
End With
CLEARFORM
LOADLIST
LOADCOMBO1
End Sub

Private Sub ComboBox1_Change()
With tbl1
r = .ListRows.Count
For t = r To 1 Step -1
.DataBodyRange.Cells(t, 36) = t '******loads range with rowctr prior to spliting with 'FILTER' ***********
Next t
End With
FILTER
items = Me.ListBox1.ListCount
End Sub

Sub FILTER()
ary = tbl1.DataBodyRange
rctr = 1
For j = 1 To UBound(ary)
If ary(j, 1) = Me.ComboBox1.Text Then
rctr = rctr + 1
End If
Next j
ReDim aryx(1 To rctr, 1 To 36)
ctr = 1
For j = 1 To UBound(ary)
If ary(j, 1) = Me.ComboBox1.Text Then
For x = 1 To 36
aryx(ctr, x) = ary(j, x)
Next x
ctr = ctr + 1
End If
Next j
Me.ListBox1.List = aryx
End Sub

Sub LOADCOMBO1()
Set ws2 = Sheet2
Set tbl1 = ws2.ListObjects("Table1")
With tbl1
If .DataBodyRange.Cells(1, 1) = vbNullString Then Exit Sub
ary = .DataBodyRange
End With
Me.ComboBox1.Clear
With CreateObject("Scripting.Dictionary")
For Each rCell In tbl1.ListColumns(1).DataBodyRange
If Not .Exists(rCell.Value) And rCell.Value <> vbNullString Then .Add rCell.Value, Nothing
Next rCell
Me.ComboBox1.List = .keys
.RemoveAll
End With
End Sub

Private Sub UserForm_Initialize()
Set ws2 = Sheet2
Set tbl1 = ws2.ListObjects("Table1")
Me.ListBox1.ColumnCount = 36
s = ""
For x = 1 To 36
s = s & 50 & ";"
Next x
Me.ListBox1.ColumnWidths = s
For x = 1 To 35
Me.Controls("Label" & x).Caption = tbl1.HeaderRowRange(x)
Next x
Me.cmdADD.Enabled = True
Me.TextBox35.Enabled = False
LOADLIST
LOADCOMBO1
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'************ensures workbook is saved if accidently closed**************
If CloseMode = vbFormControlMenu Then
Cancel = False
ThisWorkbook.Save
Unload Me
End If
End Sub

The mini sheet below is the default template the user form uses for printout (sensitive data has been removed, hence the blanks).

Setup Sheets.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1
2
3
4
5
6
7
8
9
10
11		Project Notes:
12
13
14
15
16		###		###		###		###		###		###		###
17
18		###		###		###		###		###		###
19
20		###				###		###				###		###
21
22
23
24		###
25
26
Sheet3

Thanks in advance.