VBS で画像・写真のサイズ変更ツール

嫁さんがブログに上げる写真のサイズの変更方法がわからないし、面倒くさいということだったので、Windowsの標準機能で動くツールをvbsで作成しました。

ツールをダウンロードしに来た人は、本記事の一番下からダウンロードできます。本ツールはアスペクト比(縦横比)は固定です。参考・抜粋のため、紹介しているソースを張っても動きません。使うだけの人は、ダウンロードして使用してください。

VBS で jpg への変換とサイズ変更を同時に行うツールも紹介しています。ブログ投稿には以下がおすすめです。

スマホのスクショ(PNG)が重たいので JPG に一括変換するスクリプト

いまさらながらスマホのスクショの PNG ファイルが結構なサイズであることに気がつきました。私はこのブログでスマホゲームの攻略も書いているため、よくスクショを撮ります。とったス...

hrkworks.com

2019-04-14 14:46

ゴール

画像ファイルまたは、画像ファイルが保存されているフォルダをドラック＆ドロップすることで、指定された拡縮率(指定横幅)にサイズ変更するツールを作る。
画像のサイズ変更が目的のためアスペクト比は固定。トリミングではない。

ソース解説

このプログラムの肝となるサイズ変更する関数は以下です。

16行目・17行目で、WIA.ImageProcess で指定された大きさ(率)のフィルタを作成し、18行目の Apply() で、WIA.ImageFile で取得したインプットファイルに適用します。これで、インプットファイルを拡縮処理したものが出来ます。これを20行目の SaveFile() で出力ファイルパスに保存します。インプットファイルは読むだけで変更しません。

WIA.ImageProcess：
https://docs.microsoft.com/en-us/previous-versions/windows/desktop/wiaaut/-wiaaut-imageprocess
WIA.ImageFile：
https://docs.microsoft.com/en-us/previous-versions/windows/desktop/wiaaut/-wiaaut-imagefile

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

Sub resizeImage(input, output, intScaleRatio)
Dim objFso
Dim objImg
Dim objIp

Set objFso = CreateObject( "Scripting.FileSystemObject" )
input = objFso.GetAbsolutePathName(input)
output = objFso.GetAbsolutePathName(output)

if objFso.FileExists(input) then
Set objImg = CreateObject("WIA.ImageFile")
objImg.LoadFile(input)

Set objIp = CreateObject("WIA.ImageProcess")
objIp.Filters.Add(objIp.FilterInfos("Scale").FilterID)
objIp.Filters(1).Properties("MaximumWidth").Value = objImg.Width * (intScaleRatio/100)
objIp.Filters(1).Properties("MaximumHeight").Value = objImg.Height * (intScaleRatio/100)
Set objImg = objIp.Apply(objImg)

objImg.SaveFile(objFso.GetAbsolutePathName(output))
End if

Set objImg = Nothing
Set objIp = Nothing
Set objFso = Nothing
End Sub

ツールのダウンロード

以下からダウンロードしてください。

本プログラムを利用して生じた、いかなる損害も当方は一切の責任を負わないものとします。

拡縮率指定版
 横幅指定版

使い方

元ファイルは変更されないように作成していますが、特に初回は念のためバックアップをとってご利用ください。

ダウンロードしたファイルを解凍します。.vbsファイルが1つ出てきます。
.vbsファイルに対象の画像ファイルまたは、フォルダをドラック＆ドロップします。
ツールと同じディレクトリにoutというフォルダが作成されます。
拡縮比または、横幅を指定をして「OK」をクリックしてください。
処理が終了したら終了ダイアログが出ます。outの中に、同じファイル名でサイズ変更されたファイルが入ります。

zipファイルを解凍せずに、ドラック＆ドロップの利用はできません。

Exif dpi設定版

コメントで質問をいただきましたが、特定の jpg/jpeg で画像がつぶれて見える問題があるようです。具体的には WIA.ImageProcess の Apply() で参照している可能性のある Exif 情報が無いか壊れている場合に起こると考えられます。この質問で利用した画像では、Exif TAGID の 282:XResolution (画面の幅の解像度) が正しく設定されていなかったようで、WIA.ImageProcess の Apply() 後に縦と横の解像度がズレてしまったと考えています。
そのためこの質問に対しては、対症療法として以下のように 282:XResolution (画面の幅の解像度) と 283:YResolution (画面の縦の解像度) を明示的に設定するコードを追加して回避しました。他にも必要な Exif があれば同じような感じで追加して対応も可能だと思います。一度 png にコンバートして Exif を削除してしまうのもありでしょう。jpg/jpeg のまま利用したいのであれば、不要な Exif を remove するのもありだと思います。

1
2
3
4
5
6
7
8
9
10
11

If LCase(objFso.GetExtensionName(input)) = "jpg" Or LCase(objFso.GetExtensionName(input)) = "jpeg" Then
objIp.Filters.Add(objIp.FilterInfos("Exif").FilterID)
objIp.Filters(2).Properties("ID").Value = 282
objIp.Filters(2).Properties("Type").Value = 1005
objIp.Filters(2).Properties("Value").Value = 96

objIp.Filters.Add(objIp.FilterInfos("Exif").FilterID)
objIp.Filters(3).Properties("ID").Value = 283
objIp.Filters(3).Properties("Type").Value = 1005
objIp.Filters(3).Properties("Value").Value = 96
End If

使い方は、通常版と同じです。以下からダウンロード可能です。
Exif dpi設定版拡縮率指定版
 Exif dpi設定版横幅指定版