中文字幕理论片,69视频免费在线观看,亚洲成人app,国产1级毛片,刘涛最大尺度戏视频,欧美亚洲美女视频,2021韩国美女仙女屋vip视频

Sub ToPdf2()

Application.ScreenUpdating= False

'關(guān)閉屏幕更新

'遍歷指定文件夾下的所有工作薄--Dir()函數(shù)

'Dir[(pathname[,attributes])]

'兩個(gè)參數(shù)都是可選的，attributes表示文件屬性。

'返回一個(gè)文件名、目錄名或文件夾名稱，它必須與指定的模式或文件屬性、或磁盤卷標(biāo)相匹配

'在第一次調(diào)用 Dir 函數(shù)時(shí)，必須指定 pathname，否則會(huì)產(chǎn)生錯(cuò)誤。

'dir會(huì)返回匹配pathname的第一個(gè)文件名，若想得到其他匹配pathname的文件名，再一次調(diào)用dir，且不要使用參數(shù)。如果已沒有合乎條件的文件，則dir會(huì)返回一個(gè)零長(zhǎng)度字符串（''）.

'一旦返回零長(zhǎng)度字符串，并要再次調(diào)用dir時(shí)，就必須指定pathname,就會(huì)產(chǎn)生錯(cuò)誤。不必訪問(wèn)到所有匹配當(dāng)前pathname的文件名，就可以改變到一個(gè)新的pathname上，但是，不能以 _

 遞歸方式來(lái)調(diào)用Dir函數(shù)。以VBDirectory屬性來(lái)調(diào)用Dir不能連續(xù)的返回子目錄

Dim fname As String

Dim mypath As String

mypath= ThisWorkbook.Path

fname= Dir(mypath & '\目標(biāo)文件夾\*.xlsx')

Do While Len(fname) <> 0

    Workbooks.Open mypath & '\目標(biāo)文件夾\'& fname

     ChDrive 'e:\'      

'設(shè)置當(dāng)前驅(qū)動(dòng)器為E盤即目標(biāo)文件夾所在的盤符

     ChDir mypath & '\目標(biāo)文件夾\pdf\' 

'設(shè)置PDF文件存儲(chǔ)位置,本示例存儲(chǔ)在原EXCEL所在文件夾的PDF文件夾中，如無(wú)此語(yǔ)句，默認(rèn)存儲(chǔ)在宏工作簿所在路徑

'文件另存為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() 

'第二次調(diào)用dir函數(shù)，不帶任何參數(shù)，則函數(shù)返回同一目錄下的下一個(gè).xlsx文件

Loop

Application.ScreenUpdating= True

'打開屏幕更新

End Sub

----------------------------------------