我正在尝试使用 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