Skip to content

Instantly share code, notes, and snippets.

@shangdev

shangdev/vbs

Created March 3, 2025 05:25
Show Gist options
  • Save shangdev/59e828f87d8f2c654af022c06e48bccd to your computer and use it in GitHub Desktop.
Save shangdev/59e828f87d8f2c654af022c06e48bccd to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. shangdev created this gist Mar 3, 2025.
    50 changes: 50 additions & 0 deletions vbs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,50 @@
    Option Explicit

    ' 创建文件系统对象和Excel应用程序对象
    Dim fso, excel, currentFolder, file, saveAsFile, ws

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set excel = CreateObject("Excel.Application")

    ' 获取当前文件夹路径
    currentFolder = fso.GetAbsolutePathName(".")

    ' 遍历当前文件夹中的所有文件
    For Each file In fso.GetFolder(currentFolder).Files
    ' 检查文件是否为Excel文件
    If fso.GetExtensionName(file.Name) = "xls" Or fso.GetExtensionName(file.Name) = "xlsx" Then
    ' 打开Excel文件
    excel.Workbooks.Open file.Path

    ' 设置PDF文件名（与Excel文件同名，但扩展名为.pdf）
    saveAsFile = fso.BuildPath(currentFolder, fso.GetBaseName(file.Name) & ".pdf")

    ' 遍历所有工作表
    For Each ws In excel.ActiveWorkbook.Worksheets
    ws.Activate

    ' 尝试将所有列调整到一页宽度
    On Error Resume Next
    ws.PageSetup.Zoom = False ' 禁用自动缩放
    ws.PageSetup.FitToPagesWide = 1
    ws.PageSetup.FitToPagesTall = False
    Next

    ' 将Excel文件另存为PDF
    excel.ActiveWorkbook.ExportAsFixedFormat 0, saveAsFile

    ' 关闭Excel文件
    excel.ActiveWorkbook.Close False

    WScript.Echo "已将 " & file.Name & " 转换为 PDF"
    End If
    Next

    ' 退出Excel应用程序
    excel.Quit

    ' 释放对象
    Set excel = Nothing
    Set fso = Nothing

    WScript.Echo "转换完成！"