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