玖叶教程网

前端编程开发入门

VBA技巧——批量将工作簿转换为PDF

Sub ToPdf2()

Application.ScreenUpdating= False

'关闭屏幕更新

'遍历指定文件夹下的所有工作薄--Dir()函数

'Dir[(pathname[,attributes])]

'两个参数都是可选的,attributes表示文件属性。

'返回一个文件名、目录名或文件夹名称,它必须与指定的模式或文件属性、或磁盘卷标相匹配

'在第一次调用 Dir 函数时,必须指定 pathname,否则会产生错误。

'dir会返回匹配pathname的第一个文件名,若想得到其他匹配pathname的文件名,再一次调用dir,且不要使用参数。如果已没有合乎条件的文件,则dir会返回一个零长度字符串("").

'一旦返回零长度字符串,并要再次调用dir时,就必须指定pathname,就会产生错误。不必访问到所有匹配当前pathname的文件名,就可以改变到一个新的pathname上,但是,不能以 _

递归方式来调用Dir函数。以VBDirectory属性来调用Dir不能连续的返回子目录

Dim fname As String

Dim mypath As String

mypath= ThisWorkbook.Path

fname= Dir(mypath & "\目标文件夹\*.xlsx")

Do While Len(fname) <> 0

Workbooks.Open mypath & "\目标文件夹\"& fname

ChDrive "e:\"

'设置当前驱动器为E盘即目标文件夹所在的盘符

ChDir mypath & "\目标文件夹\pdf\"

'设置PDF文件存储位置,本示例存储在原EXCEL所在文件夹的PDF文件夹中,如无此语句,默认存储在宏工作簿所在路径

'文件另存为PDF,与上例一样

Workbooks(fname).ExportAsFixedFormatType:=xlTypePDF, Filename:= _

Left(fname, InStrRev(fname, ".") -1) & ".pdf", Quality:= _

xlQualityStandard,IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Workbooks(fname).Close savechanges:=False

fname = Dir()

'第二次调用dir函数,不带任何参数,则函数返回同一目录下的下一个.xlsx文件

Loop

Application.ScreenUpdating= True

'打开屏幕更新

End Sub

发表评论:

控制面板
您好,欢迎到访网站!
  查看权限
网站分类
最新留言