Sub 一列自动筛选打印成图片_筛选名称做文件名()
   'ImagePrinter 打印成图片，选中Save Original name，Add '1' to first page有多页时自动加_1,_2,_3
   'ImagePrinter 取消Add JobID
   'Excel文件第一列数据不能为空
   
   Dim slt_col
   Dim arr, brr, i As Long
   Dim rg As Range
   Dim objDic As Object
   Dim org_name As String
   Dim new_name As String
   Dim old_name As String

   Set slt_rng = Application.InputBox("请选拆分依据列！只能选择单列！", Title:="提示", Type:=8)
   slt_col = slt_rng.Column
 
   MsgBox " 准备按【" & ActiveSheet.Cells(1, slt_col) & "】列进行分类筛选，并打印"
   Set rg = ActiveSheet.Range("a1").CurrentRegion
   arr = ActiveSheet.Range("a1").CurrentRegion
   Set objDic = CreateObject("scripting.dictionary")
  
   '获取桌面路径
   Dim WshShell As Object
   Dim desktop  As String
   Set WshShell = CreateObject("WScript.Shell")
   desktop = WshShell.SpecialFolders("Desktop")
   desktop = desktop & "\"
   
   Dim wsh As Object
   Set wsh = CreateObject("WScript.Shell")
   Dim fso As Object
   Set fso = CreateObject("Scripting.FileSystemObject")
      
   'ImagePrinter打印的图片名  A.xlsx时打印成A.xlsx.jpg，而A.xls打印成A.jpg
   org_name = ActiveWorkbook.Name
   If Split(ActiveWorkbook.Name, ".")(1) = "xls" Or Split(ActiveWorkbook.Name, ".")(1) = "xlsx" Then
       org_name = Split(ActiveWorkbook.Name, ".")(0)
   End If
   

 1 2 下一页 尾页