概要
アプリのスクリーンショットをpngファイルにするマクロ。
事前にC#をビルドする必要あり。
- 画像ではマクロをショートカットに登録しています。
背景
アプリのスクリーンショット画像をセルに書いてあるファイル名で保存したい。
「スクリーンショットを取ってExcelに貼り付ける」記事は調べると出てくる。
- スクショをExcelに張り付けるのに役立つ4つのテクニック (2_3)：テストエビデンス取得自動化の秘技（後編）- ＠IT
- 画面をキャプチャする - moug モーグ
- Excel シートにスクリーンショットを自動貼り付けするマクロ - Corredor
- エビデンス取得マクロツール(スクリーンショットキー押すだけ) - Qiita
が、ちょっと違う。コレジャナイ。
嵌ったポイント1 - Excelへの貼り付け用の例しか見つからない
Excelだけでクリップボードからpngファイル化する例はほとんど見つけられませんでした。
近いのは・・・ペイント(mspaint.exe), ADODB, SendKeysを駆使した
です。
C#でクリップボード→pngファイルを組んでしまったほうが安定するかな・・・と考えて, C#でコンソールぽく実装します(作り方はフォームアプリ)。
嵌ったポイント2 - アプリが最小化されているとうまく取得できない
最小化されている場合, AppActivateだけではアプリ画面が最前面化されないようです。
そこで, Word Taskオブジェクトを使って, ウィンドウの状態を標準に戻してからアクティブにしています。
' ターゲットアプリのタイトルバー文字列
Const APP_TITLE = "ターゲット"
・・・
'****
' 1. ターゲットアプリをアクティブにする
'****
' 最小化されている場合, AppActivateしても画面が出てこない.
' WordのTaskオブジェクトでwindowStateを操作して, 標準の状態に戻したあと,
' アクティブにする
If objWord.Tasks(APP_TITLE).WindowState = 2 Then
objWord.Tasks(APP_TITLE).WindowState = 0
End If
Dim AppFullName
AppFullName = objWord.Tasks(APP_TITLE).Name
AppActivate AppFullName, False
よく考えると, **objWord.Tasks()にActivateメソッドがある**んだった・・・以下でよかったかな。。。
' ターゲットアプリのタイトルバー文字列
Const APP_TITLE = "ターゲット"
・・・
'****
' 1. ターゲットアプリをアクティブにする
'****
' 最小化されている場合, AppActivateしても画面が出てこない.
' WordのTaskオブジェクトでwindowStateを操作して, 標準の状態に戻したあと,
' アクティブにする
If objWord.Tasks(APP_TITLE).WindowState = 2 Then
objWord.Tasks(APP_TITLE).WindowState = 0
End If
objWord.Tasks(APP_TITLE).Activate
嵌ったポイント3 - Windowsのアニメーション効果が有効だとタイミングが合わない
Windows10のアニメーション効果が有効だと, AppActivate後に少しWaitを入れないとダメなようです。
「アニメーション後」を取る方法がなさそうだったのでSleepでアクティブ待ちをしています。
'****
' 2. ターゲットアプリのアクティブ待ち
'****
' Windows10のアニメーション効果が有効な場合, AppActivateのあと少しウェイトを入れる必要がある
Call Sleep(300)
嵌ったポイント4 - AppActivateは完全なタイトルバーの文字列でないといけない
objWord.Tasks(APP_TITLE)は部分一致でいける一方でAppActivateは完全なタイトルバーの文字列(プロセスのフレンドリ名?)でないとダメなようです。
objWord.Tasks(APP_TITLE).Nameで取得したものAppActivateに渡します。
Dim AppFullName
AppFullName = objWord.Tasks(APP_TITLE).Name
AppActivate AppFullName, False
コード
VBA - 主体となる部分
Option Explicit
' win32api
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
'仮想キーコード
Const VK_SNAPSHOT = &H2C ' Printscreen
Const VK_MENU = &H12 ' Alt
' ターゲットアプリのタイトルバー文字列
Const APP_TITLE = "ターゲット"
' ターゲットアプリのスクリーンショット画像(.png)を取得する.
' 出力ファイル名は選択したセルの文字列を使う
Public Sub GetScreenshotPng()
Dim objWsh
Set objWsh = CreateObject("WScript.Shell")
Dim objFso
Set objFso = CreateObject("Scripting.FileSystemObject")
Dim objWord
Set objWord = CreateObject("Word.Application")
'****
' 0. エラーチェック
'****
' ターゲットアプリの存在確認
If Not objWord.Tasks.Exists(APP_TITLE) Then
MsgBox APP_TITLE & "が見つかりません"
GoTo ReleaseObjects
End If
' ファイル名の確認
Dim outFileName
outFileName = Selection.Value
If outFileName = "" Then
MsgBox "出力ファイル名が空白です"
GoTo ReleaseObjects
End If
'****
' 1. ターゲットアプリをアクティブにする
'****
' 最小化されている場合, AppActivateしても画面が出てこない.
' WordのTaskオブジェクトでwindowStateを操作して, 標準の状態に戻したあと,
' アクティブにする
If objWord.Tasks(APP_TITLE).WindowState = 2 Then
objWord.Tasks(APP_TITLE).WindowState = 0
End If
Dim AppFullName
AppFullName = objWord.Tasks(APP_TITLE).Name
AppActivate AppFullName, False
'****
' 2. ターゲットアプリのアクティブ待ち
'****
' Windows10のアニメーション効果が有効な場合, AppActivateのあと少しウェイトを入れる必要がある
Call Sleep(300)
'****
' 3. Alt + PrintScreenを押下する
'****
'Alt + PrintScreen
Call keybd_event(VK_MENU, 0, 1, 0) 'Alt押下
Call keybd_event(VK_SNAPSHOT, 0, 1, 0) 'PrintScreen押下
Call keybd_event(VK_SNAPSHOT, 0, 3, 0) 'PrintScreen離し
Call keybd_event(VK_MENU, 0, 3, 0) 'Alt離し
'****
' 4. クリップボードの画像をpngファイル化する
'****
' get_clipboard_image.exeのパスを作成(.xlsmと同じフォルダにあることを期待)
Dim cmd
cmd = """" & objFso.BuildPath(ThisWorkbook.Path, "get_clipboard_image.exe") & """"
' get_clipboard_image.exeの引数(出力ファイル名)を作成(.xlsmと同じフォルダに出力することを期待)
Dim arg
arg = """" & objFso.BuildPath(ThisWorkbook.Path, Selection.Value) & """"
' 「get_clipboard_image.exe 出力ファイル名」を実行
Call objWsh.Run(cmd & " " & arg, 0, True)
ReleaseObjects:
objWord.Quit
Set objWord = Nothing
Set objFso = Nothing
Set objWsh = Nothing
End Sub
注1
xlsmと同じフォルダに「get_clipboard_image.exe」が置かれることを決めうちした実装になっています。
png出力先も「xlsmと同じフォルダ」の決めうちです。ファイル名だけ選択したセルからとってきています。
注2
' ターゲットアプリのタイトルバー文字列
Const APP_TITLE = "ターゲット"
を変更することでスクリーンショットを取るアプリを変更できます。
この記事ではHTAで作成したダミーアプリをターゲットにしています。
注3
簡単化のため, マクロ呼び出しごとに各種オブジェクトを生成＋破棄してますが、 実際使うときはWorkBookを開いたときに生成してそれを使いまわす形がいいです。
※ 概要の動画gifのように特に最初のスクリーンショットが重くなる。
注4
objWord.Tasks(APP_TITLE)は部分一致で判定しているので, 似ているタイトルのアプリがいるとうまく動作しない可能性があります。objWord.Tasks(APP_TITLE)をFor Eachでまわして, フルネームを判定に使えばもう少しマシになると思います。
Dim AppFullName
AppFullName = objWord.Tasks(APP_TITLE).Name
C# - クリップボードの画像をpngファイル化するアプリ
コンソール画面が出ると気になるので「何もフォームを作らないフォームアプリ」を作成します。
プロジェクト作成時は「Windowsフォームアプリケーション」を指定し,
プロジェクト名を「get_clipboard_image」とします。
ソリューションエクスプローラでProgram.csを開きます。
これを以下のコードで置き換えます。
using System;
using System.Collections.Generic;
using System.Linq;
using System.Threading.Tasks;
using System.Windows.Forms;
using System.Drawing;//追加
using System.Drawing.Imaging;//追加
namespace get_clipboard_image
{
static class Program
{
/// <summary>
/// アプリケーションのメイン エントリ ポイントです。
/// </summary>
[STAThread]
static int Main(string[] args)
{
//Application.EnableVisualStyles();
//Application.SetCompatibleTextRenderingDefault(false);
//Application.Run(new Form1());
if(args.Length == 1)
{
var fname = args[0];
var clip = Clipboard.GetDataObject();
// 画像ファイルのみ取り込み
var bmp = clip.GetData(typeof(Bitmap)) as Bitmap;
if (bmp != null)
{
bmp.Save(fname, ImageFormat.Png);
Clipboard.Clear();
return 0;
}
else
{
MessageBox.Show("クリップボードに画像が見つかりませんでした。");
return 1;
}
}
else
{
MessageBox.Show("使い方:get_clipboard_image.exe [ファイル名]");
return 2;
}
}
}
}
「Release」「Any CPU」でビルドすればget_clipboard_image.exeができます。
xlsmと同じフォルダにおいてください。
html - ターゲットアプリ
ダミーのターゲットアプリ。
なんでもよかったので古の技術HTA
テキストエディタに貼り付けて「target.hta」で保存すれば終わりです。
ダミーのターゲットアプリは、「<html><head><title>ターゲット</title></head></html>」の一行だけでもいいですし, 「ターゲット.txt」をメモ帳で開いても代替できます。
<html>
<head>
<title>ターゲット</title>
</head>
<script type="text/javascript">
window.onload = function myCheck(){
window.resizeTo(400,120);
start=new Date();
setInterval("DispTime()",1);
}
function DispTime(){
now = new Date();
document.getElementById("display").innerText = now.getTime() - start.getTime()
}
</script>
<body>
<font size=7><div id="display"></div></font>
</body>
</html>