如何用PowerPoint VBA遍历图片像素并修改颜色？

核心思路 #

PowerPoint的Shape对象无法直接操作像素，需要先将图片导出为临时文件，借助StdPicture和Bitmap对象读取、修改像素，最后替换回幻灯片中的原图片。

完整代码实现 #

首先需要在VBA编辑器中添加两个引用：

• 打开VBA编辑器（按Alt+F11），点击「工具」→「引用」，勾选Microsoft Windows Common Controls 6.0 (SP6) 和 Microsoft ActiveX Data Objects 6.1 Library

Option Explicit

' Windows API声明，用于图片流处理
Private Declare Function OleLoadPicture Lib "olepro32.dll" (ByVal lpStream As IUnknown, ByVal lSize As Long, ByVal fRunMode As Long, ByRef riid As GUID, ByRef ppvObj As IUnknown) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ByRef ppstm As IUnknown) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Sub ChangePicturePixels()
    Dim osld As Slide
    Dim oshp As Shape
    Dim tempPath As String
    Dim pic As StdPicture
    Dim bmp As Bitmap
    Dim x As Long, y As Long
    Dim pixelColor As OLE_COLOR
    Dim newColor As OLE_COLOR
    
    ' 系统临时目录存放处理中的图片
    tempPath = Environ("TEMP") & "\temp_edit_pic.bmp"
    
    ' 遍历所有幻灯片
    For Each osld In ActivePresentation.Slides
        For Each oshp In osld.Shapes
            ' 仅处理名称以Picture开头的图片形状
            If oshp.Name Like "Picture*" And oshp.Type = msoPicture Then
                ' 导出原图片为BMP格式临时文件
                oshp.Export tempPath, ppShapeFormatBMP
                
                ' 加载临时图片为可编辑的Bitmap对象
                Set pic = LoadPictureFromFile(tempPath)
                Set bmp = pic
                
                ' --------------------------
                ' 自定义像素修改逻辑（示例：红色转蓝色）
                newColor = RGB(0, 0, 255)
                For y = 0 To bmp.Height - 1
                    For x = 0 To bmp.Width - 1
                        pixelColor = bmp.Point(x, y)
                        ' 判断当前像素是否为纯红色，可根据需求修改条件
                        If GetRValue(pixelColor) = 255 And GetGValue(pixelColor) = 0 And GetBValue(pixelColor) = 0 Then
                            bmp.PSet (x, y), newColor
                        End If
                    Next x
                Next y
                ' --------------------------
                
                ' 保存修改后的图片
                bmp.Save tempPath
                
                ' 删除原形状，插入修改后的图片（保留原位置和尺寸）
                oshp.Delete
                osld.Shapes.AddPicture tempPath, msoFalse, msoTrue, oshp.Left, oshp.Top, oshp.Width, oshp.Height
                
                ' 清理临时文件
                Kill tempPath
            End If
        Next oshp
    Next osld
End Sub

' 辅助函数：从文件加载图片为StdPicture对象
Private Function LoadPictureFromFile(filePath As String) As StdPicture
    Dim fs As ADODB.Stream
    Dim hMem As Long
    Dim lpMem As Long
    Dim iStream As IUnknown
    Dim iidIPicture As GUID
    Dim pic As StdPicture
    
    Set fs = New ADODB.Stream
    With fs
        .Type = adTypeBinary
        .Open
        .LoadFromFile filePath
        hMem = GlobalAlloc(&H2000, .Size)
        lpMem = GlobalLock(hMem)
        .Read lpMem, .Size
        GlobalUnlock hMem
        .Close
    End With
    Set fs = Nothing
    
    CreateStreamOnHGlobal hMem, True, iStream
    
    ' 设置IPicture接口的GUID
    With iidIPicture
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    
    OleLoadPicture iStream, 0, False, iidIPicture, pic
    Set LoadPictureFromFile = pic
End Function

关键说明 #

• 像素逻辑自定义：你可以修改代码中pixelColor的判断条件和newColor的值，实现任意颜色替换或像素处理逻辑。
• 格式限制：当前代码仅支持位图（BMP）格式，若需处理PNG等带透明通道的图片，需调整导出格式和像素读取逻辑。
• 性能提示：大图片处理会耗时较长，建议先在少量幻灯片或小尺寸图片上测试。

内容的提问来源于stack exchange，提问作者JN_2605