如何通过VBA基于Excel RGB值批量修改Photoshop图层颜色？

需要通过VBA读取Excel单元格中的RGB值，批量修改PSD文件内指定图层的颜色并导出成品。现有两种PSD版本：一种带颜色叠加（Color Overlay）图层，另一种是纯色填充调整层（Fill Color Adjustment Layer），原代码无法正确修改颜色属性，求解决方案。

原代码如下：

Sub modify_psd_files()
    'Define variables for Excel and Photoshop objects
    Dim appExcel As Excel.Application
    Dim wbExcel As Excel.Workbook
    Dim wsExcel As Excel.Worksheet
    Dim appPhotoshop As Object 'Declare as Object to use late binding
    Dim docPhotoshop As Object 'Declare as Object to use late binding
    
    'Define variables for the file names and paths
    Dim filePath As String
    Dim fileName As String
    Dim savePath As String
    Dim saveName As String
    
    'Define variables for the layer name and color
    Dim layerName As String
    Dim layerColor As String
    Dim hexColor As String
    Dim r As Integer
    Dim g As Integer
    Dim b As Integer
    
    'Open Excel file and set variables
    Set appExcel = New Excel.Application
    Set wbExcel = ThisWorkbook 'Use the workbook executing the code
    Set wsExcel = wbExcel.Worksheets("PSD") 
    
    'Open Photoshop and set variables
    Set appPhotoshop = CreateObject("Photoshop.Application")
    appPhotoshop.Visible = True 'Set to False to hide Photoshop
    
    'Loop through rows in Excel and modify Photoshop file
    For i = 2 To wsExcel.Cells(wsExcel.Rows.Count, "A").End(xlUp).Row 
        'Get file name, layer name, layer color, and save name from Excel
        fileName = ThisWorkbook.Path & "\" & wsExcel.Cells(i, 1).Value 'Use workbook path as base path for file
        layerName = wsExcel.Cells(i, 2).Value
        hexColor = wsExcel.Cells(i, 3).Value
        saveName = wsExcel.Cells(i, 4).Value
        
        'Open PSD file and set variables
        Set docPhotoshop = appPhotoshop.Open(fileName)
        Dim layer As Object 'Declare as Object to use late binding
        
        'Find layer by name and change color
        For Each layer In docPhotoshop.artLayers
            If layer.Name = layerName Then
                Dim artLayer As Object 'Declare as Object to use late binding
                Set artLayer = layer
                artLayer.ApplyColorOverlay
                artLayer.adjustment.ColorBalance(0) = 100
                artLayer.adjustment.ColorBalance(1) = 100
                artLayer.adjustment.ColorBalance(2) = 100
                Exit For
            End If
        Next layer
        
        'Save modified file with new name
        savePath = Left(fileName, InStrRev(fileName, "\")) 'Get path from original file name
        docPhotoshop.SaveAs savePath & saveName & ".tga"
        docPhotoshop.Close
        
    Next i
    'Close Excel and Photoshop and clean up objects
    'wbExcel.Close
    'appExcel.Quit
    'appPhotoshop.Quit
    'Set wsExcel = Nothing
    'Set wbExcel = Nothing
    'Set appExcel = Nothing


End Sub

解决方案 #

针对两种不同类型的图层，需要调用Photoshop VBA对象模型中对应的属性来修改颜色，以下是兼容两种图层的完整代码：

Sub modify_psd_files()
    ' 定义对象变量
    Dim wbExcel As Excel.Workbook
    Dim wsExcel As Excel.Worksheet
    Dim appPhotoshop As Object
    Dim docPhotoshop As Object
    Dim layer As Object
    Dim effect As Object
    Dim psColor As Object
    
    ' 定义文件和颜色变量
    Dim fileName As String
    Dim savePath As String
    Dim saveName As String
    Dim layerName As String
    Dim hexColor As String
    Dim r As Integer, g As Integer, b As Integer
    
    ' 初始化Excel对象
    Set wbExcel = ThisWorkbook
    Set wsExcel = wbExcel.Worksheets("PSD")
    
    ' 初始化Photoshop对象
    Set appPhotoshop = CreateObject("Photoshop.Application")
    appPhotoshop.Visible = True
    
    ' 遍历Excel行（从第2行开始，第1行为表头）
    For i = 2 To wsExcel.Cells(wsExcel.Rows.Count, "A").End(xlUp).Row
        ' 读取Excel数据
        fileName = ThisWorkbook.Path & "\" & wsExcel.Cells(i, 1).Value
        layerName = wsExcel.Cells(i, 2).Value
        hexColor = wsExcel.Cells(i, 3).Value
        saveName = wsExcel.Cells(i, 4).Value
        
        ' 十六进制转RGB
        r = CLng("&H" & Mid(hexColor, 2, 2))
        g = CLng("&H" & Mid(hexColor, 4, 2))
        b = CLng("&H" & Mid(hexColor, 6, 2))
        
        ' 打开PSD文件
        Set docPhotoshop = appPhotoshop.Open(fileName)
        Set psColor = CreateObject("Photoshop.SolidColor")
        psColor.RGB.Red = r
        psColor.RGB.Green = g
        psColor.RGB.Blue = b
        
        ' 查找目标图层并修改颜色
        For Each layer In docPhotoshop.Layers
            If layer.Name = layerName Then
                ' 判断图层类型
                Select Case layer.Kind
                    ' 普通图层（带Color Overlay样式）
                    Case 1 ' psNormalLayer = 1
                        ' 检查是否已有Color Overlay效果
                        Dim hasColorOverlay As Boolean
                        hasColorOverlay = False
                        For Each effect In layer.Style.Effects
                            If effect.Kind = 5 Then ' psColorOverlayEffect =5
                                effect.Color = psColor
                                hasColorOverlay = True
                                Exit For
                            End If
                        Next effect
                        ' 如果没有Color Overlay，添加样式
                        If Not hasColorOverlay Then
                            layer.Style.Effects.Add 5 ' 添加Color Overlay
                            layer.Style.Effects(layer.Style.Effects.Count).Color = psColor
                        End If
                    
                    ' 纯色填充调整层
                    Case 23 ' psSolidColorFillLayer =23
                        layer.Adjustment.SolidColor = psColor
                End Select
                Exit For
            End If
        Next layer
        
        ' 保存并关闭文档
        savePath = Left(fileName, InStrRev(fileName, "\"))
        ' 设置保存参数（TGA格式）
        Dim saveOptions As Object
        Set saveOptions = CreateObject("Photoshop.TargaSaveOptions")
        saveOptions.Resolution = 300 ' 根据需求调整分辨率
        docPhotoshop.SaveAs savePath & saveName & ".tga", saveOptions
        docPhotoshop.Close
        
        ' 释放临时对象
        Set psColor = Nothing
        Set saveOptions = Nothing
        Set docPhotoshop = Nothing
    Next i
    
    ' 清理对象
    Set layer = Nothing
    Set appPhotoshop = Nothing
    Set wsExcel = Nothing
    Set wbExcel = Nothing
    
    MsgBox "批量处理完成！"
End Sub

关键修改说明 #

• 十六进制转RGB：通过Mid截取十六进制字符串对应部分，转换为十进制RGB值
• 颜色对象适配：使用Photoshop.SolidColor对象定义颜色，匹配Photoshop的颜色格式
• 图层类型区分：通过layer.Kind判断图层类型，普通图层对应psNormalLayer=1，纯色填充调整层对应psSolidColorFillLayer=23
• 颜色叠加样式处理：遍历图层样式的Effects集合，找到Color Overlay（psColorOverlayEffect=5）修改颜色，无该样式则自动添加
• 调整层直接修改：纯色填充调整层可直接修改SolidColor属性完成颜色替换

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