VBA选择动态名称Excel工作表导出PDF出现运行时错误9如何解决

问题根因 #

你代码出现Run-time error 9 - Subscript out of range错误有两个核心问题：

• 循环读取工作表名称的逻辑错误：现有Do While循环里添加了Exit Do语句，执行一次就会直接退出，最多只能读取B5、B6两个单元格的内容，无法匹配动态变化的工作表数量
• 工作表选择的参数类型错误：Sheets集合要选中多个工作表时，需要传入工作表名称组成的数组，你用Join把数组转成了逗号分隔的字符串，相当于你要找一个名称为"2070507 , 2070614"的单个工作表，自然找不到触发下标越界

修正后完整代码 #

Sub Send_PDF_Email()
    Dim wPath As String, wFile As String, pets As Variant, myArray As Variant
    Dim R As Long, dam As Object

    ' 正确读取Projetos表B列从第5行开始的所有非空工作表名称
    R = Sheets("Projetos").Cells(Rows.Count, "B").End(xlUp).Row
    pets = Worksheets("Projetos").Range("B5:B" & R).Value
    myArray = Application.Transpose(pets)
    
    ' 直接传数组选中多个工作表，不需要转成字符串
    ThisWorkbook.Sheets(myArray).Select
    
    wPath = ThisWorkbook.Path & Application.PathSeparator ' 补全路径分隔符，避免拼接错误
    wFile = "DadosRPO.pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=wPath & wFile, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    Set dam = CreateObject("Outlook.Application").CreateItem(0)
    dam.To = Sheets("Projetos").Cells(28, 3).Value
    dam.Subject = "Dados RPO"
    dam.Body = "Seguem os dados referentes aos projectos em execução"
    dam.Attachments.Add wPath & wFile
    dam.Send

    ' 释放对象
    Set dam = Nothing
End Sub

主要调整说明 #

• 删除了逻辑错误的Do While循环，改用End(xlUp)直接定位B列最后一行非空单元格，适配动态增减的工作表名称列表
• 删掉了Join转字符串的冗余逻辑，直接把读取到的名称数组myArray传给Sheets集合完成多选
• 路径拼接补了Application.PathSeparator，避免工作簿路径末尾没有斜杠导致的文件保存错误
• 补充了变量声明和对象释放逻辑，避免潜在报错

内容的提问来源于stack exchange，提问作者Ruben Ramalhais