Checkboxes and generating PDF VBA style

[pasjauo]

Hi guys

I have a problem with a code that I have gotten some help to do for a friends company.

On the front page they have checkboxes of the content of the pdf they want generated (quotation with various content) and the VBA is set to always include a front page and 2 back pages ("Front page" "xxx last page"). Now they want a 3rd back page ("last page") added, and I have succeeded. That have though lead the 3rd back page to cannibalize on the content of the checkboxes. I know the theory of what is wrong but I can't seem to find the place where i can do anything about it.

I have translated my sheet names in this code to give a better picture of what the sheets represent.

Sub generatepdf()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Application.PrintCommunication = False

On Error Resume Next
Dim d() As Variant

Sheets("Front Page").Select
Client = Range("C2").Value
sh = ""
y = -1
For Each chk In ActiveSheet.CheckBoxes

If chk.Value = 1 Then
    SheetName = chk.Text
    If SheetName = "ONE IMPORT" Then
    y = y + 1
    ReDim d(y)
    d(0) = "Quote One Import"
    Sheets("Quote One Import").Activate
    With ActiveSheet.PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With
    ActiveSheet.UsedRange.Select
    Sheets("Quote One Import").PageSetup.CenterHorizontally = True
    sh = sh & IIf(sh = "", "", ",") & "Quote One Import"
   
    ElseIf SheetName = "TWO IMPORT" Then
    y = y + 1
    ReDim d(y)
    d(0) = "Quote Two Import"
    Sheets("Quote Two Import").Activate
    With ActiveSheet.PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .CenterHorizontally = True
End With
    ActiveSheet.UsedRange.Select
    sh = sh & IIf(sh = "", "", ",") & "Quote Two Import"
   
    ElseIf SheetName = "THREE IMPORT" Then
    y = y + 1
    ReDim d(y)
    d(0) = "Quote Three Import"
    Sheets("Quote Three Import").Activate
    With ActiveSheet.PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With
    ActiveSheet.UsedRange.Select
    Sheets("Quote Three Import").PageSetup.CenterHorizontally = True
    sh = sh & IIf(sh = "", "", ",") & "Quote Three Import"
   
    ElseIf SheetName = "ONE EXPORT" Then
    y = y + 1
    ReDim d(y)
    d(0) = "Quote One Export"
    Sheets("Quote One Export").Activate
    With ActiveSheet.PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .PageSetup.CenterHorizontally = True
End With
    ActiveSheet.UsedRange.Select
    sh = sh & IIf(sh = "", "", ",") & "Quote One Export"
   
    ElseIf SheetName = "TWO EXPORT" Then
    y = y + 1
    ReDim d(y)
    d(0) = "Quote Two Export"
    Sheets("Quote Two Export").Activate
    With ActiveSheet.PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .PageSetup.CenterHorizontally = True
End With
    ActiveSheet.UsedRange.Select
    Sheets("Quote Two Export").PageSetup.CenterHorizontally = True
    sh = sh & IIf(sh = "", "", ",") & "Quote Two Export"
   
    ElseIf SheetName = "THREE EXPORT" Then
    y = y + 1
    ReDim d(y)
    d(0) = "Quote Three Export"
    Sheets("Quote Three Export").Activate
    With ActiveSheet.PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With
    ActiveSheet.UsedRange.Select
    Sheets("Quote Three Export").PageSetup.CenterHorizontally = True
    sh = sh & IIf(sh = "", "", ",") & "Quote Three Export"
   
    ElseIf SheetName = "ONE CROSS" Then
    y = y + 1
    ReDim d(y)
    d(0) = "Quote One Cross"
    Sheets("Quote One Cross").Activate
    With ActiveSheet.PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With
    ActiveSheet.UsedRange.Select
    Sheets("Quote One Cross").PageSetup.CenterHorizontally = True
    sh = sh & IIf(sh = "", "", ",") & "Quote One Cross"
   
    ElseIf SheetName = "TWO CROSS" Then
    y = y + 1
    ReDim d(y)
    d(0) = "Quote Two Cross"
    Sheets("Quote Two Cross").Activate
    With ActiveSheet.PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With
    ActiveSheet.UsedRange.Select
    Sheets("Quote Two Cross").PageSetup.CenterHorizontally = True
    sh = sh & IIf(sh = "", "", ",") & "Quote Two Cross"
    End If
End If
Next
sh1 = sh
y = y + 3
ded = 2
If InStr(sh, "One") > 0 Or InStr(sh, "Two") > 0 Then
'    y = y + 1
'   ded = 2
   
  '  Sheets("AddS").Activate
   ' ActiveSheet.Range("a1:r120").Select
    'ActiveSheet.PrintArea = ActiveSheet.Range("a1:t110").Address
End If

'With Worksheets("Adds").PageSetup
'   .FitToPagesWide = 1
  '  .FitToPagesTall = False
'End With

ReDim d(y)
If sh <> "" Then
For i = 1 To UBound(d) - ded
    lens = IIf(i = 0 And InStr(sh, ",") > 0, InStr(sh, ",") - 1, IIf(InStr(sh1, ",") > 0, InStr(sh1, ",") - 1, Len(sh1)))
    st = IIf(i = 0, 1, InStr(sh1, ",") + 1)
    d(i) = Mid(sh1, 1, lens)
    sh1 = Mid(sh, InStr(sh, d(i)) + Len(d(i)) + 1)
Next
If ded = 2 Then
    d(UBound(d) - ded + 1) = "AddS"
End If



'    Sheets("AddS").PageSetup.Zoom = False
'   Sheets("AddS").PageSetup.FitToPagesWide = 1
  '  Sheets("AddS").PageSetup.FitToPagesTall = 1
   
'If sh <> "" Then
'For i = 0 To UBound(d)
'   lens = IIf(i = 0 And InStr(sh, ",") > 0, InStr(sh, ",") - 1, IIf(InStr(sh1, ",") > 0, InStr(sh1, ",") - 1, Len(sh1)))
  '  st = IIf(i = 0, 1, InStr(sh1, ",") + 1)
   ' d(i) = Mid(sh1, 1, lens)
   ' sh1 = Mid(sh, InStr(sh, d(i)) + Len(d(i)) + 1)
'Next
    
d(0) = "Front page"
d(UBound(d) - 2) = "Last page"
d(UBound(d) - 1) = "3rd last page"
d(UBound(d)) = "2nd last page"
    Sheets("Front page").Activate
    ActiveSheet.Range("a1:j70").Select
    Sheets("Front page").PageSetup.CenterHorizontally = True
    Sheets("3rd last page").Activate
    ActiveSheet.Range("a1:j70").Select
    Sheets("3rd last page").PageSetup.CenterHorizontally = True
    Sheets("2nd last page").Activate
    ActiveSheet.Range("a1:j70").Select
    Sheets("2nd last page").PageSetup.CenterHorizontally = True
    Sheets("last page").Activate
    ActiveSheet.Range("a1:j70").Select
    Sheets("last page").PageSetup.CenterHorizontally = True
'ThisWorkbook.Sheets(Array(sh)).Select

ThisWorkbook.Sheets(d).Select

Selection.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
        ThisWorkbook.Path & "\" & " " & Client & "_" & Format(Now(), "ddmmyyyy\") & ".pdf", _
          Quality:=xlQualityStandard, IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
'Application.PrintCommunication = True

sh = ""
Sheets("Front page").Select

MsgBox " PDF GENERERET", vbOKOnly + vbInformation, "Succes"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub