マルチスクリーンのスクショをトリミングしたい（VBS）

2022/6/29 VBS

マルチスクリーンは便利ですが、スクショをとった場合に、2画面分のスクショが取れて加工に困ることがあります。今回は、リサイズの記事でご質問を受けて、そういえばトリミングについて記事を書いていなかったなと思い立ったので、記事にしてみました。例によって、ダウンロードもありますので、使いたいだけの人は記事の最後へどうぞ。

写真・画像を JPG から PNG に変換し、サイズを変更する VBS のツール

前回の記事で紹介した画像サイズ変更ツールの記事に、コメントでサイズ変更後に縦横の dpi がズレてしまうという報告がありました。調査の結果、この現象は画像の Exif 情報が崩...

hrkworks.com

2019-02-24 22:34

ゴール

アプリをインストールしなくていい、VBSで何とかしたい。画像ファイルまたは、画像ファイルが保存されているフォルダをドラック＆ドロップすることで、左側のスクリーン（私の環境でメインスクリーン）がトリミングされるツールを作る。画像の種類(jpg,png)は変更しない。

ソースコード解説

このプログラムの肝となるトリミングする関数は以下です。18行目・19行目で、WIA.ImageProcess で指定された大きさのフィルタを作成し、21行目の Apply() で、WIA.ImageFile で取得したインプットファイルに適用します。これで、インプットファイルをトリミングしたものが出来ます。これを23行目の SaveFile() で出力ファイルパスに保存します。インプットファイルは読むだけで変更しません。

右側のスクリーンをとりたい場合や、フルHDではないマルチスクリーンの場合は、18行目、19行目の数字を、調整してください。

参考：
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
27
28
29

Sub trimImage(input, outputpath)
Dim objImg
Dim objIp
Dim output

input = objFso.GetAbsolutePathName(input)
output = objFso.GetAbsolutePathName(outputpath)

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")

' Cut Right Screen
objIp.Filters.Add(objIp.FilterInfos("Crop").FilterID)
objIp.Filters(1).Properties("Left") = 0
objIp.Filters(1).Properties("Right") = 1920

Set objImg = objIp.Apply(objImg)

objImg.SaveFile(objFso.GetAbsolutePathName(output))

End if

Set objImg = Nothing
Set objIp = Nothing
End Sub