☰

Excel 批量将 XLS 转换为 XLSX 并更改 PPI 设置

tag-icon • tag-icon microsoft-excel conversion
Excel 批量将 XLS 转换为 XLSX 并更改 PPI 设置

我正在尝试将大量旧 .xls 文件转换为 .xlsx 格式，同时更改 ppi 设置。使用某种脚本或宏可以实现这一点吗？将一个满是图片的工作簿中的 ppi 从 220ppi 更改为 96ppi 可以减小尺寸。

我发现这一页，但想知道它是否仍然适用于 Office 2013/2016 组件以及如何使用可能的 ppi 更改来更新它。

下面给出了一个编译错误，指出“用户定义类型未定义”，其中说Dim FSO As Scripting.FileSystemObject

Option Explicit

' Convert all xls files in selected folder to xlsx

Sub convertXLStoXLSX()

Dim FSO As Scripting.FileSystemObject
Dim strConversionPath As String
Dim fFile As File
Dim fFolder As Folder
Dim wkbConvert As Workbook


' Open dialog and select folder
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    strConversionPath = .SelectedItems(1)
End With

Set FSO = New Scripting.FileSystemObject

' Check if the folder exists
If FSO.FolderExists(strConversionPath) Then
    Set fFolder = FSO.GetFolder(strConversionPath)

    ' Loop through files, find the .xls files
    For Each fFile In fFolder.Files
        If Right(fFile.Name, 4) = ".xls" Or Right(fFile.Name, 4) = ".XLS" Then
            Application.DisplayAlerts = False
            Set wkbConvert = Workbooks.Open(fFile.Path)
            ' Save as XML workbook - if file contains macros change FileFormat:=52
            wkbConvert.SaveAs FSO.BuildPath(fFile.ParentFolder, Left(fFile.Name, Len(fFile.Name) - 4)) & ".xlsx", FileFormat:=51
            wkbConvert.Close SaveChanges:=False
            ' Delete original file
            fFile.Delete Force:=True
            Application.DisplayAlerts = True
        End If
    Next fFile

End If

End Sub

答案1

更改代码

wkbConvert.SaveAs FSO.BuildPath(fFile.ParentFolder, Left(fFile.Name, Len(fFile.Name) - 4)) & ".xlsx", FileFormat:=51

经过

wkbConvert.SaveAs Replace(ThisWorkbook.FullName, ".xls", ".xlsx"), FileFormat:=xlExcel12

相关内容