vba - Excel 到 PDF 转换的宏
问题描述
我正在编写下面的代码以将文件夹中的多个 excel 文件转换为 PDF,但在第 1 行出现错误。38 是“无效的过程调用或参数”
我对 VBA 很陌生,所以无法捕捉到错误,请帮助...
Sub BatchOpenMultiplePSTFiles()
Dim objShell As Object
Dim objWindowsFolder As Object
Dim strWindowsFolder As String
'Select the specific Windows folder
Set objShell = CreateObject("Shell.Application")
Set objWindowsFolder = objShell.BrowseForFolder(0, "Select a Windows folder:", 0, "")
If Not objWindowsFolder Is Nothing Then
strWindowsFolder = objWindowsFolder.self.Path & "\"
Call ProcessFolders(strWindowsFolder)
'Open the windows folder
Shell "Explorer.exe" & " " & strWindowsFolder, vbNormalFocus
End If
End Sub
Sub ProcessFolders(strPath As String)
Dim objFileSystem As Object
Dim objFolder As Object
Dim objFile As Object
Dim objExcelFile As Object
Dim objWorkbook As Excel.Workbook
Dim strWorkbookName As String
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSystem.GetFolder(strPath)
For Each objFile In objFolder.Files
strFileExtension = objFileSystem.GetExtensionName(objFile)
If LCase(strFileExtension) = "xls" Or LCase(strFileExtension) = "xlsx" Then
Set objExcelFile = objFile
Set objWorkbook = Application.Workbooks.Open(objExcelFile.Path)
strWorkbookName = Left(objWorkbook.Name, (Len(objWorkbook.Name) - Len(strFileExtension)) - 1)
objWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPath & strWorkbookName & ".pdf"
objWorkbook.Close False
End If
Next
'Process all folders and subfolders
If objFolder.SubFolders.Count > 0 Then
For Each objSubFolder In objFolder.SubFolders
If ((objSubFolder.Attributes And 2) = 0) And ((objSubFolder.Attributes And 4) = 0) Then
ProcessFolders (objSubFolder.Path)
End If
Next
End If
End Sub
解决方案
试试这个方法。
Sub Convert_Excel_To_PDF()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
Dim LPosition As Integer
'Fill in the path\folder where the Excel files are
MyPath = "C:\your_path\"
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0
If Not mybook Is Nothing Then
LPosition = InStr(1, mybook.Name, ".") - 1
mybookname = Left(mybook.Name, LPosition)
mybook.Activate
'All PDF Files get saved in the directory below:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Documents and Settings\shuerya\Desktop\PDFFiles\" & mybookname & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End If
mybook.Close SaveChanges:=False
Next Fnum
End If
If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
推荐阅读
- python - PySpark DataFrames 是否具有像 Pandas 中的“管道”功能?
- c - 如何修复警告 C4047?
- java - 线程无参构造函数有什么用?
- javascript - 如何在 Django 中使用 ajax 和 vanilla JavaScript 从 MultipleChoiceField 获取正确的值
- python - 如何在 Django 3.1 上排除挂起的迁移
- osmnx - 从 OSMNX Consolidate Intersections 获取 XY 坐标/纬度
- python - 如何使用我训练过的模型编写 keras 来读取我自己的图片?
- api - _TypeError in call api flutter
- google-cloud-platform - 在 BigQuery 中存储日期/日期时间/时间/时间戳
- python - 卡住试图从“for”循环滚动两个列表框