复选框不选择用于生成PDF的工作表

时间:2017-08-10 19:29:26

标签: arrays vba checkbox pdf-generation

我有一个Active X按钮,单击该按钮会显示一个Userform,其中包含工作簿中每个工作表的复选框。我想要做的是允许用户选择他们想要生成哪些工作表到PDF。目前,无论用户点击生成PDF的输入按钮后选择了什么复选框,工作簿中的所有工作表都包含在PDF中而非选择的内容中,子工具不会自动结束,我必须自动进入VBA并按下停止按钮。所以,如果你能让我知道我的代码出错了,为什么复选框没有选择我希望生成PDF的工作表。提前感谢您的帮助!

Private Sub chbxEnter_Click()

Dim PDFsheets As String
Dim s As Worksheet
PDFsheets = "Approval Form,Business Plan,Deal Worksheet,All Manager Deal Recap,Deal Recap,MEC Dealership Profile,Loyal,Mid Loyal,Non Loyal,Projected Incentive Report,MEC"
ary = Split(PDFsheets, ",")

    If CheckBox1.Value = True Then
    PDFsheets = "Approval Form"
    End If

    If CheckBox2.Value = True Then
        If PDFsheets = "" Then
        PDFsheets = "Business Plan"
    Else
        PDFsheets = PDFsheets & ",Business Plan"
    End If
    End If

    If CheckBox3.Value = True Then
        If PDFsheets = "" Then
        PDFsheets = "Deal Worksheet"
    Else
        PDFsheets = PDFsheets & ",Deal Worksheet"
    End If
    End If


    If CheckBox4.Value = True Then
    If PDFsheets = "" Then
       PDFsheets = "Deal Recap"
    Else
        PDFsheets = PDFsheets & ",Deal Recap"
    End If
    End If

    If CheckBox5.Value = True Then
    If PDFsheets = "" Then
       PDFsheets = "All Manager Deal Recap"
    Else
        PDFsheets = PDFsheets & ",All Manager Deal Recap"
    End If
    End If

    If CheckBox6.Value = True Then
    If PDFsheets = "" Then
       PDFsheets = "MEC Dealership Profile"
    Else
        PDFsheets = PDFsheets & ",MEC Dealership Profile"
    End If
    End If

    If CheckBox7.Value = True Then
    If PDFsheets = "" Then
       PDFsheets = "Loyal"
    Else
        PDFsheets = PDFsheets & ",Loyal"
    End If
    End If

    If CheckBox8.Value = True Then
    If PDFsheets = "" Then
       PDFsheets = "Mid Loyal"
    Else
        PDFsheets = PDFsheets & ",Mid Loyal"
    End If
    End If

    If CheckBox9.Value = True Then
    If PDFsheets = "" Then
       PDFsheets = "Non Loyal"
    Else
        PDFsheets = PDFsheets & ",Non Loyal"
    End If
    End If

    If CheckBox10.Value = True Then
    If PDFsheets = "" Then
       PDFsheets = "Projected Incentive Report"
    Else
        PDFsheets = PDFsheets & ",Projected Incentive Report"
    End If
    End If

    If CheckBox11.Value = True Then
    If PDFsheets = "" Then
       PDFsheets = "MEC"
    Else
        PDFsheets = PDFsheets & ",MEC"
    End If
    End If

ThisWorkbook.Sheets(ary).Select
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    strPath & strFName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

 ActiveWindow.SelectedSheets(1).Select


End Sub

1 个答案:

答案 0 :(得分:0)

未经测试,但我认为这应该做你需要的。许多重复的逻辑被分解成一个单独的子。

Option Explicit

Private Sub chbxEnter_Click()

    Dim pdfSheets As String

    pdfSheets = ""

    AddASheet CheckBox1, pdfSheets, "Approval Form"
    AddASheet CheckBox2, pdfSheets, "Business Plan"
    AddASheet CheckBox3, pdfSheets, "Deal Worksheet"
    AddASheet CheckBox4, pdfSheets, "Deal Recap"
    AddASheet CheckBox5, pdfSheets, "All Manager Deal Recap"
    AddASheet CheckBox6, pdfSheets, "MEC Dealership Profile"
    AddASheet CheckBox7, pdfSheets, "Loyal"
    AddASheet CheckBox8, pdfSheets, "Mid Loyal"
    AddASheet CheckBox9, pdfSheets, "Non Loyal"
    AddASheet CheckBox10, pdfSheets, "Projected Incentive Report"
    AddASheet CheckBox11, pdfSheets, "MEC"


    ThisWorkbook.Sheets(Split(pdfSheets, ",")).Select
      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        strPath & strFName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

     ActiveWindow.SelectedSheets(1).Select
End Sub

'utility: add a sheet name if a checkbox is checked
Sub AddASheet(cb, ByRef pdfSheets As String, shtName As String)
    If cb.Value Then
        pdfSheets = pdfSheets & IIf(Len(pdfSheets) > 0, ",", "") & shtName
    End If
End Sub