PowerPointで画像や図形を選択して右クリックすると、メニューに「図として保存(S)」というものが表示される。

これを押すと、pngがデフォルトで画像を保存することができる。

私は、よくこの機能を使うのだが、基本的にjpeg保存するので、毎回保存方式を変更して保存するということをやっており、地味にめんどくさい。

というわけで、AutoHotkeyでショートカット作ろう！ということになった。

取り合えず、ComObjCreate(“PowerPoint.Application”)でpowerpoint叩けばいけるだろとVBAのコードを調べてみたところ、Shape.ExportメソッドやShapeRange.Exportメソッドを使えばいけそうという情報が出てきたのでテストしてみた。

Sub test()
    Dim Pic As Object
    Set Pic = ActiveWindow.Selection.ShapeRange    '選択した図形をPicに入れる'
    Pic.Export PathName:="01ppt.jpg", Filter:=ppShapeFormatJPG
End Sub

という感じでパワポのマクロを書いたら、サクッと選択した図をjpg保存できた。

後は、これをAHKに移植でOKと思ったんだけど、出てきた画像をよく見ると、右クリックから図として保存として保存した時より、解像度が低い。。。

ClipBoardからペイントに貼り付けても同じ解像度だったので、PowerPointの「図として保存」は、PowerPoint内部が持ってる画像の解像度で保存されるが、ExportはPowerPointに表示されている解像度で保存されるみたい。
通常なら、VBAの編集画面を右クリック→オブジェクトブラウザーで保有しているメソッドが確認できるが、Exportは、オブジェクトブラウザーの画面で更に右クリック→非表示のメンバーを表示としないと出てこないメソッドだった。古いメソッドなのだろうか？

Sub Export(PathName As String, Filter As PpShapeFormat, [ScaleWidth As Long], [ScaleHeight As Long], [ExportMode As PpExportMode = ppRelativeToSlide])

PowerPoint.PpShapeFormat のメンバー
Const ppShapeFormatGIF = 0
Const ppShapeFormatJPG = 1
Const ppShapeFormatPNG = 2
Const ppShapeFormatBMP = 3
Const ppShapeFormatWMF = 4
Const ppShapeFormatEMF = 5

PowerPoint.PpExportMode のメンバー
Const ppRelativeToSlide = 1
Const ppClipRelativeToSlide = 2
Const ppScaleToFit = 3
Const ppScaleXY = 4

もしかして、他に最新のmethodが出来てるのかと思い探してみたが、ShapeRange.SaveAsPicture メソッド (Publisher)というものしか見つからず、どうもPowerPointには無いっぽい。

仕方がないので、力業でAHKで叩くことにした。

#IfWinActive,ahk_exe POWERPNT.EXE
	sc07B & s::
		if(GetKeyState("Ctrl","P")){
			send,{AppsKey}s
			send,{tab}j
			send,+{tab}
		}
	return
#IfWinActive

パワーポイントで画像などを選択し、Ctrl+無変換+sを押すと、保存形式がjpgの状態で図として保存の保存名入力画面が開く。

余り美しくないが止む無し。。。

2022/05/11追記

日本語入力がONだと保存ファイル種別のjpg切り替えるのがうまく行かなかった。

IME.ahkで全角入力になってたら一旦半角にするように修正。

#Include IME.ahk

sc07B & s::
	if(GetKeyState("Ctrl","P")){
		PowerPointSaveSelectedImgJpg()
	}
return
PowerPointSaveSelectedImgJpg(){
	IME_Status:=IME_GET()
	if (IME_Status){
		IME_SET(0)
	}
	send,{AppsKey}s
	send,{tab}j
	send,+{tab}
	if (IME_Status){
		Sleep 700
		IME_SET(1)
	}
}