上一篇
下一篇
用VBScript编程控制Photoshop自动处理批量图片
作者:淡月清风 日期:2009-05-15
' VBScript source code
'==========================================================================
' NAME : 用VBScript编程控制Photoshop自动处理批量图片
' (VBScript Control Photoshop for auto resize photos...)
' (VBScript Control Photoshop for auto resize photos...)
' AUTHOR : 淡月清风 QQ:259177377 E-Mail:dgx_lsyd3@163.com
' DATE : 2009年5月14日23:51:22
' COMMENT : 遍历指定目录下的所有图片(包括子目录),对图片的大小进行调整,并存储。
' 当然，用Photoshop录制动作，再执行批处理也可以勉强实现。
' VERSION : 1.0
'==========================================================================
'//设置Photoshop的单位是像素
Const DEF_psPixels = 1
'//要处理的目录
Const DEF_Directory = "C:\Documents and Settings\Administrator\桌面\照片"
Set fso=CreateObject("Scripting.FileSystemObject")
Set objPhotoshopApp=CreateObject("Photoshop.Application")
Call InitPhotoshop(objPhotoshopApp) '//初始化PS
Call TraversingFolder(DEF_Directory) '//处理制定目录下的所有图片
Call ExitPhotoshop(objPhotoshopApp) '//退出PS
'------------------------------------------------------
'//遍历所有文件夹
Sub TraversingFolder(FolderPath)
If fso.FolderExists(FolderPath) Then
Set ofolder=fso.GetFolder(FolderPath)
'//FolderPath目录下的所有文件
Set files=ofolder.Files
For Each file In files
'WScript.Echo file.Path
Call ResizePhoto(file.Path)
Next
'//FolderPath目录下的所有子目录
Set SubFolders=ofolder.SubFolders
For Each folder in SubFolders
Call TraversingFolder(folder.Path)
Next
End If
End Sub
'//调整照片大小
Sub ResizePhoto(ImageFilePath)
'On Error Resume Next
'//仅处理jpg格式的
If LCase(Right(ImageFilePath,4))<>".jpg" Then
Exit Sub
End If
Dim objDocument
'//WScript.Echo ImageFilePath
Set objDocument=OpenImage(objPhotoshopApp,ImageFilePath)
If IsNull(objDocument) Then'//打开了无效文件
Call CloseImage(objDocument)
Exit Sub
End If
Dim nWidth,nHeight
nWidth=GetImageWidth(objDocument)
nHeight=GetImageHeight(objDocument)
If nWidth=2048 And nHeight=1536 Then '//横向的
Call ResizeImage(objDocument,1600,1200,96)
ElseIf nWidth=1536 And nHeight=2048 Then '//纵向的
Call ResizeImage(objDocument,1200,1600,96)
Else
Call CloseImage(objDocument)
Exit Sub
End If
Call CloseImage(objDocument)
Exit Sub
End Sub
'//打开图片
Function OpenImage(oPhotoshop,ImageFilePath)
Dim oDocument
Set oDocument=Nothing
If fso.FileExists(ImageFilePath) Then
oPhotoshop.Open(ImageFilePath)
Set oDocument=oPhotoshop.Documents.Item(1)
Set OpenImage=oDocument
End If
End Function
'//关闭图片
Sub CloseImage(oDocument)
oDocument.Close
end Sub
'//获取图片宽度
Function GetImageWidth(oDocument)
GetImageWidth=oDocument.Width
End Function
'//获取图片高度
Function GetImageHeight(oDocument)
GetImageHeight=oDocument.Height
End Function
'//修改图片大小
Sub ResizeImage(oDocument,nWidth,nHeight,nResolution)
oDocument.ResizeImage nWidth,nHeight,nResolution,3 '参数依次为：宽，高，分辨率(比如96像素/英寸)，采样类型
oDocument.Save
End Sub
'//初始化Photoshop
Sub InitPhotoshop(oPhotoshop)
oPhotoshop.Preferences.RulerUnits=DEF_psPixels '设置默认单位为像素
Do While oPhotoshop.Documents.Count '关闭所有已打开的文档
oPhotoshop.ActiveDocument.Close
Loop
End Sub
'//退出Photoshop
Sub ExitPhotoshop(oPhotoshop)
objPhotoshopApp.Quit
End Sub
文章来自: 
引用通告: 
Tags: 
收藏到网摘:
相关日志:
评论: 0 | 引用: 0 | 查看次数: 659
发表评论
你没有权限发表评论！
