複選框不選擇用於PDF生成的工作表

Question

我有一個Active X按鈕，單擊時會爲我的工作簿中的每個工作表打開一個帶有複選框的用戶窗體。我想要做的是允許用戶選擇他們想要生成的PDF到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 

Answer 1

未經測試，但我認爲這應該做你所需要的。許多重複的邏輯被分解爲一個單獨的子。

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