前回の記事で紹介した画像サイズ変更ツールの記事に、コメントでサイズ変更後に縦横の dpi がズレてしまうという報告がありました。調査の結果、この現象は画像の Exif 情報が崩れている可能性があるためと解釈し、相談のあった画像で壊れてそうな Exif のみを修正する対症療法を考えました。ただ、どの Exif が問題を起こすのかもわかりませんし、そもそもブログに上げる写真の Exif 情報は消したいと考えることも多いでしょう。
GPS などの個人情報に関する Exif だけを消してもよかったのですが、消すべき Exif を検討するのが面倒なため Exif 情報を持たない png ファイルに変換してサイズ変更しようという乱暴なアプローチです。
ゴール
png形式で保存すること以外は、前回と同じです。
画像ファイルまたは、画像ファイルが保存されているフォルダをドラック&ドロップすることで、指定された拡縮率(指定横幅)にサイズ変更し、png形式で保存するツールを作る。
画像のサイズ変更が目的のためアスペクト比は固定。トリミングではない。
ソースコード
サイズ変更とPNG変更を一気にやる関数です。サイズ変更の肝は前回と同様です。19-20行目で、PNG形式に変換するフィルタを追加しています。strPNGFormat は、”{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}” という文字列になります。あとは、前回のサイズ変更ツールと同じです。
なお、出力はパスを受け取るようにしました。7行目で「もとのファイル名.png」というファイル名に変更しています。
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 27 28 29 30 | Sub resizeImage(input, outputpath, intWidth) Dim objImg Dim objIp Dim output input = objFso.GetAbsolutePathName(input) output = objFso.GetAbsolutePathName(outputpath & "" & objFso.getBaseName(input) &".png") if objFso.FileExists(input) And Not objFso.FileExists(output) And Not objFso.FolderExists(output) And isImgFile(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 = intWidth objIp.Filters(1).Properties("MaximumHeight").Value = objImg.Height * (intWidth/objImg.Width) objIp.Filters.Add(objIp.FilterInfos("Convert").FilterID) objIp.Filters(2).Properties("FormatID").Value = strPNGFormat Set objImg = objIp.Apply(objImg) objImg.SaveFile(objFso.GetAbsolutePathName(output)) End if Set objImg = Nothing Set objIp = Nothing End Sub |
ツールのダウンロード
以下からダウンロードしてください。
使い方
元ファイルは変更されないように作成していますが、特に初回は念のためバックアップをとってご利用ください。
- ダウンロードしたファイルを解凍します。.vbsファイルが1つ出てきます。
- .vbsファイルに対象の画像ファイルまたは、フォルダをドラック&ドロップします。
- ツールと同じディレクトリにoutというフォルダが作成されます。
- 拡縮比または、横幅を指定をして「OK」をクリックしてください。
- 処理が終了したら終了ダイアログが出ます。outの中に、同じファイル名でPNG変換とサイズ変更されたファイルが入ります。