vba 在 photoshop 中改变颜色

问题描述 投票:0回答:0

我正在尝试使用 vba 更改图层的颜色

基本上,我有一个纹理文件,我想根据单元格值更改其上的图层,因为我需要创建很多它们。电子表格中的颜色值采用 R G B 格式。

我有两个版本的PSD文件(可以修改),一个有颜色叠加,另一个只是作为调整层填充颜色。

试了下面的,也试过找对象中的color属性,但是没找到>

有什么建议吗?

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") 'Replace "PSD" with the name of your worksheet
    
    '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 'Assumes data starts in row 2
        '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
vba photoshop photoshop-script
© www.soinside.com 2019 - 2024. All rights reserved.