欢迎光临散文网 会员登陆 & 注册

当 VBA 遇上 ChatGPT:解锁无限创造力与自动化的力量!

2023-06-21 20:40 作者:数字冠军RPA  | 我要投稿

完整代码如下:

Sub ExportWorksheetToPDF()

  '定义变量

  Dim wsName As String

  Dim ws As Worksheet

  Dim myPath As String

  Dim myFile As String

  Dim myExtension As String

  Dim wb As Workbook


  '设定Active Workbook

  Set wb = ActiveWorkbook


  '从B2单元格获取工作表名称

  wsName = ThisWorkbook.Sheets("Sheet1").Range("B2").Value


  '在活动工作簿中查找具有这个名称的工作表

  On Error Resume Next '如果没有找到工作表,跳过错误

  Set ws = wb.Sheets(wsName)

  On Error GoTo 0 '重新启用错误


  '如果没有找到工作表,退出宏

  If ws Is Nothing Then

    MsgBox "No worksheet named " & wsName & " found.", vbExclamation

    Exit Sub

  End If


  '获取文件路径,文件名和扩展名

  myPath = wb.Path

  myFile = Left(wb.Name, InStrRev(wb.Name, ".", -1, vbTextCompare) - 1)

  myExtension = ".pdf"


  '导出工作表为PDF

  ws.ExportAsFixedFormat Type:=xlTypePDF, _

              Filename:=myPath & "\" & myFile & "_" & ws.Name & myExtension, _

              Quality:=xlQualityStandard, _

              IncludeDocProperties:=True, _

              IgnorePrintAreas:=False, _

              OpenAfterPublish:=False


  '确认消息

  MsgBox "Worksheet exported as PDF to: " & myPath & "\" & myFile & "_" & ws.Name & myE

xtension


End Sub

当 VBA 遇上 ChatGPT:解锁无限创造力与自动化的力量!的评论 (共 条)

分享到微博请遵守国家法律