Excel+VBA+FFmpeg全能图片处理利器:批量选择、调整尺寸、压缩质量、图片合并,水平垂直合并一键搞定!

Excel+VBA+FFmpeg全能图片处理利器

本文介绍的 VBA 脚本主要实现以下功能:

为什么选择Excel结合VBA与FFmpeg处理图片?

1.多功能集成,一站式解决方案

集成图片的批量选择、调整尺寸、压缩质量以及合并功能,满足在不同场景下的多样化需求,无需切换多个软件工具。

2.自动化操作,省时省力

通过双击Excel中的指定单元格,即可自动执行复杂的图片处理任务,减少手动操作,提升工作效率。

3.灵活定制,适应不同需求

根据具体需求设置目标宽度、高度、压缩质量,并选择合并方式(水平或垂直),灵活应对各种图片处理场景。

4.高质量输出,保证专业水准

借助FFmpeg的强大处理能力,确保处理后的图片质量,无论是用于商业展示还是个人项目,都能达到专业水准。

功能亮点详解

1.批量选择与导入图片路径

通过双击Excel中的A1单元格,弹出文件选择对话框,轻松选择多张图片。选定的图片路径将自动填入A列,便于后续管理与处理。

2.智能获取图片信息

系统自动读取每张图片的格式、分辨率及文件大小,信息一目了然,可以更好地了解和管理图片资源。

3.批量调整图片尺寸与压缩质量

在E 、F列填写目标宽度和高度,G列填写压缩质量(默认值为2)。双击I1单元格,VBA脚本将自动调整所有选定图片的尺寸与质量,处理后的图片将保存在新建的文件夹中。

4.灵活合并图片

  • 水平合并:

    双击K1单元格,即可将选定的多张图片水平拼接成一张长图,适用于制作横幅或展示图集。

  • 垂直合并:

    双击J1单元格,即可将选定的多张图片垂直堆叠成一张高图,适用于制作竖版海报或图册。

5.自动化管理,提升效率

处理完成后,所有优化后的图片将自动保存在指定文件夹中,整洁有序,便于后续使用与管理。同时,生成详细的日志文件,方便追踪与排查问题。

下面,我们将逐一解析每个部分的具体实现和功能。

1. 双击单元格事件处理,Worksheet_BeforeDoubleClick 事件


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error Resume Next
    If Target.Address = "$A$1" Then
        Call GetSelectedImagePaths
        Cancel = True
    End If
    If Target.Address = "$I$1" Then
        Call RunFFCommand
        Cancel = True
    End If
    If Left(Target.Address, 2) = "$I" Or Left(Target.Address, 2) = "$A" Then
        If Target.Address <> "$I$1" And Target.Address <> "$A$1" Then
            If Target.Value <> "" Then
                Cancel = True
                ThisWorkbook.FollowHyperlink Address:=Target.Value
            End If
        End If
    End If
    If Target.Address = "$J$1" Then
        Call VMergeImagesRecursively
        Cancel = True
    End If
    If Target.Address = "$K$1" Then
        Call HorizontalImageMerger
        Cancel = True
    End If
End Sub

功能说明:


* 触发条件:当用户在工作表中双击某个单元格时,该事件被触发。
* 操作逻辑:
* 双击 $A$1 单元格:调用 GetSelectedImagePaths 子程序,用于选择图片文件路径。
* 双击 $I$1 单元格:调用 RunFFCommand 子程序,执行 FFmpeg 命令。
* 双击 $I 或 $A 列的其他单元格:如果单元格有值,跳转到该值对应的超链接。
* 双击 $J$1 单元格:调用 VMergeImagesRecursively 子程序,执行垂直合并图像操作。
* 双击 $K$1 单元格:调用 HorizontalImageMerger 子程序,执行水平合并图像操作。

通过这种方式,用户可以通过简单的双击操作,快速执行不同的图像处理任务,提高工作效率。

2.FFmpeg进程管理,KillFFmpegIfRunning 子程序

Sub KillFFmpegIfRunning()
    On Error Resume Next
    Dim objWMI As Object
    Dim objProcess As Object
    Dim colProcess As Object
    ' 获取WMI服务
    Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
    If objWMI Is Nothing Then
        Exit Sub
    End If
    ' 查询进程
    Set colProcess = objWMI.ExecQuery("Select * from Win32_Process Where Name = 'ffmpeg.exe'")
    If colProcess.Count = 0 Then
        Exit Sub
    End If
    ' 遍历并终止所有FFmpeg进程
    For Each objProcess In colProcess
        objProcess.Terminate
    Next
End Sub

功能说明:


* 目的:在需要时终止所有正在运行的 FFmpeg 进程,释放系统资源。
* 实现方法:
* 利用 WMI(Windows Management Instrumentation)查询系统中所有名为 ffmpeg.exe 的进程。
* 遍历查询结果,逐个终止这些进程。

这种方法确保在执行图像处理任务前,系统中不会有残留的 FFmpeg 进程占用资源,避免潜在的冲突和资源浪费。

3. 工作表格式化,FormatContext 子程序


Sub FormatContext()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Sheets(1).Range("A1:K" & [a65536].End(3).Row)
        .Font.Name = "宋体"
        .Font.Size = 12
        .Font.Underline = xlUnderlineStyleNone
        .Font.ColorIndex = xlAutomatic
        .Borders.LineStyle = xlContinuous
        .Borders.ColorIndex = 0
        .Borders.TintAndShade = 0
        .Borders.Weight = xlThin
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Sheets(1).Rows("2:10000").RowHeight = 13.25
    Sheets(1).Range("B2").Select
    Sheets(1).Cells.EntireColumn.AutoFit
    Columns("I:I").ColumnWidth = Columns("A:A").ColumnWidth + 20
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

功能说明:


* 目的:统一格式化工作表,提高可读性和美观度。
* 操作内容:
* 字体设置:使用“宋体”字体,字号为12,取消下划线,自动颜色。
* 边框设置:为范围内的单元格添加连续线条边框,线条颜色为默认。
* 对齐方式:水平左对齐,垂直居中。
* 文本格式:取消自动换行,取消单元格合并。
* 行高与列宽调整:
* 设置第2行到第10000行的行高为13.25。
* 自动调整所有列的宽度以适应内容。
* 将列 I 的宽度设置为列 A 宽度加20,以容纳更长的内容。

通过该子程序,可以确保生成的工作表具有统一且专业的外观,便于用户查看和操作。

4. 选择并处理图片路径,GetSelectedImagePaths 子程序


Sub GetSelectedImagePaths()
    Dim fd As FileDialog
    Dim i As Long
    Dim ws As Worksheet
    Dim selectedFilePath As Variant
    ' 设置当前工作表
    Set ws = ThisWorkbook.Sheets(1) ' 修改为目标工作表名称或索引
    ' 创建文件选择对话框
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    ' 配置对话框属性
    With fd
        .Title = "选择图片文件"
        .Filters.Clear
        .Filters.Add "图片文件", "*.jpg; *.jpeg; *.png; *.gif; *.bmp;*.tif;*.tiff;*.ico"
        .AllowMultiSelect = True
        ' 如果用户选择了文件
        If .Show = -1 Then
            ' 初始化起始单元格行
            Rows("2:65536").Clear
            i = 2
            ' 遍历选中的文件路径
            For Each selectedFilePath In .SelectedItems
                ' 写入文件路径到A列
                ws.Cells(i, 1).Value = selectedFilePath
                i = i + 1
            Next selectedFilePath
            Else
            Exit Sub
        End If
    End With
        Call RunGetImageResolutionAsDictionary
        Call FormatContext
End Sub

功能说明:


* 目的:通过文件对话框让用户选择多个图片文件,并将选中的文件路径写入工作表的 A 列。
* 实现步骤:
1.创建文件对话框:设置标题为“选择图片文件”,过滤器仅显示常见的图片格式(如 JPG、PNG 等),允许多选。
2.用户选择文件:
* 如果用户选择了文件,清空工作表第2行到最后一行的内容,从第2行开始,将每个选中的文件路径写入 A 列。
* 如果用户取消操作,则退出子程序。
3.后续操作:
* 调用 RunGetImageResolutionAsDictionary 子程序,获取每个图片的分辨率和其他信息。
* 调用 FormatContext 子程序,格式化工作表

此子程序简化了用户选择和记录图片路径的过程,为后续的图像处理打下基础。

5. 获取图片分辨率信息,GetImageResolutionAsDictionary 函数


Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "gdiplus" (ByVal fileName As LongPtr, ByRef bitmap As LongPtr) As Long
Private Declare PtrSafe Function GdipGetImageWidth Lib "gdiplus" (ByVal image As LongPtr, ByRef width As Long) As Long
Private Declare PtrSafe Function GdipGetImageHeight Lib "gdiplus" (ByVal image As LongPtr, ByRef height As Long) As Long
Private Declare PtrSafe Function GdipDisposeImage Lib "gdiplus" (ByVal image As LongPtr) As Long
Private Declare PtrSafe Function GdiplusStartup Lib "gdiplus" (ByRef token As LongPtr, ByRef inputbuf As GdiplusStartupInput, ByVal outputbuf As LongPtr) As Long
Private Declare PtrSafe Function GdiplusShutdown Lib "gdiplus" (ByVal token As LongPtr) As Long
Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As LongPtr
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值