
下記のVBAコードをご覧ください。
こちらは、動きます。
内容は、プリントスクリーン【パソコンの全画面】をスクショして
エクセルに貼付します。
自分のやりたことは、全画面ではなく、アクティブなウィンドウだけを
スクショしてエクセルに貼付したいです。
手動でやるなら、 Alt+「PrtSc (PrintScreen)」でできます。
これをVBAにて出来ないでしょうか。
ご存じの方いましたら、教えて下さい。
【コード】
'キーボードイベント用のライブラリ読み込み
Private Declare PtrSafe Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long _
)
Sub スクショ貼付()
Set ws = ActiveSheet
keybd_event vbKeySnapshot, 0&, fKEYDOWN, 0&
keybd_event vbKeySnapshot, 0&, fKEYUP, 0&
Application.Wait Now() + TimeValue("00:00:01")
With ws
.Range("A1").Select
.Paste
'Selection.Copy
Set sp1 = .Shapes(.Shapes.Count)
End With
End Sub
A 回答 (4件)
- 最新から表示
- 回答順に表示
No.4
- 回答日時:
>同じように、するコードをご指導、お願いできませんでしょうか。
クロームのウィンドウ特定する部分はコメントに入れてあります
'ウィンドウタイトルに"Google Chrome"が含まれているか'
If InStr(MyName, CY_SEARCH_NAME) > 0 Then
実行プロシージャ最初に 変数CY_SEARCH_NAME = "Google Chrome" としていますね
他のWindowに対して制御する場合は、これを変更すれば良いです
同様に実行プロシージャ最後に
CY_SEARCH_NAME = ThisWorkbook.Windows(1).Caption
Call EnumWindows(AddressOf GetProc, 0)
を実行しています
この実行を行わないとThisWorkbookのWindowが最前面に表示されません
API Functionは長ったらしくありますが実行プロシージャはシンプルです
ご質問者様はVBAを作る側でしょうから・・
単に使う側になって欲しくはないのでプロシージャコードは割愛しますが
悪しからず(たぶん簡単に出来ると思いますので試してください)
No.3
- 回答日時:
クロームのウィンドウをスクショしたいと言う事ですね
ボタンから実行 Sheets(1)に貼り付け サイズ変更は別スレでしたね
オーナーwindowですが・・長いので分けます
Option Explicit
'WinAPI宣言'
#If Win64 Then
'【GetWindow関数】オーナーフォームハンドル取得
Declare PtrSafe Function GetWindow Lib "user32" ( _
ByVal hwnd As LongPtr, _
ByVal wCmd As Long) As LongPtr
'【GetWindowText関数】キャプション取得'
Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr
'【SetForegroundWindow関数】
Declare PtrSafe Sub SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr)
Dim hwnd As LongPtr
#Else
'【GetWindow関数】オーナーフォームハンドル取得
Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, ByVal wCmd As Long) As Long
'【GetWindowText関数】キャプション取得'
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
'【SetForegroundWindow関数】
Declare Sub SetForegroundWindow Lib "user32" (ByVal hwnd As Long)
Dim hwnd As Long
#End If
'ウィンドウ列挙'
Declare Function EnumWindows Lib "user32" ( _
ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare PtrSafe Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long _
)
Private Const fKEYDOWN = &H1
Private Const fKEYUP = &H1 Or &H2
Private Const ERROR_SUCCESS = &H0
'定数
Public Const GW_OWNER = 4
Public Const WM_CLOSE = &H10
'変数
Dim CY_SEARCH_NAME As String
Public Function GetProc(ByVal hwnd As Long, lParam As Long) As Boolean
Dim MyName As String * 128
Dim ret As Long
MyName = ""
'ウィンドウタイトルを取得'
ret = GetWindowText(hwnd, MyName, Len(MyName))
'オーナーウィンドウかの判定'
If GetWindow(hwnd, GW_OWNER) = 0 Then
If ret <> 0 Then
'ウィンドウタイトルに"Google Chrome"が含まれているか'
If InStr(MyName, CY_SEARCH_NAME) > 0 Then
SetForegroundWindow hwnd
DoEvents 'OSによって処理されるように制御を戻す
GetProc = False
Exit Function
End If
End If
End If
GetProc = True
End Function
Sub スクショ貼付() '他のシートボタン登録
CY_SEARCH_NAME = "Google Chrome"
Call EnumWindows(AddressOf GetProc, 0)
'vb定数:16進数:キー
'vbKeyMenu:&H12:Alt
'vbKeySnapshot :&H2C:PrintScreen
keybd_event vbKeyMenu, 0, fKEYDOWN, 0&
keybd_event vbKeySnapshot, 0, fKEYDOWN, 0&
DoEvents 'OSによって処理されるように制御を戻す
keybd_event vbKeyMenu, 0, fKEYUP, 0&
keybd_event vbKeySnapshot, 0, fKEYUP, 0&
Application.Wait Now() + TimeValue("00:00:01")
Dim ws As Worksheet
Dim sp1 As Shape
ThisWorkbook.Activate
Set ws = Worksheets(1)
With ws
.Select
.Range("A1").Select
.Paste
Set sp1 = .Shapes(.Shapes.Count)
End With
'ExcelBook
CY_SEARCH_NAME = ThisWorkbook.Windows(1).Caption
Call EnumWindows(AddressOf GetProc, 0)
End Sub
めちゃくちゃすごいコードありがとうございました。
ちゃんと、アクティブになっているクロームだけ
スクショが貼付られます。
Qchan1962様、今回クロームがアクティブになっているもの
について、教授いただきましたが
これをインターネットエクスプローラー【エッジではなく昔のです】
にて、同じように、するコードをご指導、お願いできませんでしょうか。
お手すきな時に宜しくお願いいたします。
No.2
- 回答日時:
こんばんは、途中まで書いて落ちてしまいました書き直しします
ご質問のコードには Altキーへの命令がありません(それを聞きたいのかな)
また、Altキー+PrintScreenキーを押下してすぐに戻すと正しくOSで処理できない可能性があります
簡単にコード内に説明を付けサンプルします
Private Declare PtrSafe Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long _
)
Private Const fKEYDOWN = &H1
Private Const fKEYUP = &H1 Or &H2
Dim ws As Worksheet
Dim sp1 As Shape
Sub スクショ貼付()
'vb定数:16進数:キー
'vbKeyMenu:&H12:Alt
'vbKeySnapshot :&H2C:PrintScreen
keybd_event vbKeyMenu, 0, fKEYDOWN, 0&
keybd_event vbKeySnapshot, 0, fKEYDOWN, 0&
DoEvents 'OSによって処理されるように制御を戻す
keybd_event vbKeyMenu, 0, fKEYUP, 0&
keybd_event vbKeySnapshot, 0, fKEYUP, 0&
Application.Wait Now() + TimeValue("00:00:01")
Set ws = ActiveSheet
With ws
.Range("A1").Select
.Paste
Set sp1 = .Shapes(.Shapes.Count)
End With
End Sub
まだ課題が残りそうですね
アクティブとは移ろうな状態です
ボタンからVBAを実行するとおそらくはそのボタンが設置されたシートを
表示するウィンドウがアクティブウィンドウです
他のアプリケーションウィンドウをスクショしたくてもどのようにVBAを実行すれば良いのか・・
ボタンからVBAを実行
ウィンドウを名前などで探し(特定し)アクティブにして
スクショ・・シートに貼り付け・・
課題の参考例
WindowsAPI ウインドウを取得
https://officevba.info/example-findwindow/
Windowオブジェクトを取得する
https://www.officepro.jp/excelvba/window/index1. …
いつも回答ありがとうございます。
出来ました。ALT+PrintScreeen。
たしかに、マクロが貼ってあるボタンのエクセルが
最後、アクティブとなり、スクショされますね。
当初の目的の、例えば、ウィンドウがエクセル含め3つ
あって、クロームのウィンドウがアクティぶになっている。
同じウィンドウだけをスクショしたくても、最後には
マクロがあるエクセルがアクティブになって、スクショ
されますねえ。
ヒントを例、さがしてみます。
No.1
- 回答日時:
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) 【マクロ】スクショ印刷がうまく動かない件 5 2022/12/06 17:37
- Access(アクセス) Vba Userformを前面に出すについて 3 2022/04/15 12:29
- Visual Basic(VBA) エクセルのVBAでダブルクリックでチェックを入れたあと 1 2022/10/26 20:30
- Visual Basic(VBA) エクセルVBA ダブルクリックしたら色反転を指定したセルのみにしたい 2 2022/04/06 12:52
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Excel(エクセル) エクセル VBA実行中のApplication.ScreenUpdatingについて 3 2023/07/13 21:06
- Visual Basic(VBA) VBAで質問ですが、皆さんはどの様に導き出しているのでしょうか? 6 2022/05/03 21:53
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Visual Basic(VBA) ダブルクリックでセルの色を変える 1 2022/12/24 15:52
このQ&Aを見た人はこんなQ&Aも見ています
-
【マクロ】プリントスクリーンした画像をエクセルに貼付して印刷したい
Excel(エクセル)
-
Excel 範囲指定スクショについて Excelで範囲指定してスクリーンショットする機能がありますが
Visual Basic(VBA)
-
エクセルのVBAでクリップボードにコピーした画像をpng(or jpg or bmp)保存したい
Visual Basic(VBA)
-
-
4
VBAで保存しないで閉じると空のBookが残る
Excel(エクセル)
-
5
アクセスの画面をプリントスクリーンでとる方法
その他(ソフトウェア)
-
6
vba クリップボードクリアについて教えてください
その他(プログラミング・Web制作)
-
7
VBAのコマンドボタンの文字列の改行方法は?
Visual Basic(VBA)
-
8
エクセル:マクロ「Application.CutCopyMode = False」って?
Excel(エクセル)
-
9
エクセルのラベルの値(文字列)を垂直方向で中央揃えにするには?
Excel(エクセル)
-
10
エクセルvbaでの図形のカット(コピー)ペーストについて
Excel(エクセル)
-
11
EXCEL VBA 複数のImageコントロールにクリップボードに保存されている画像を表示したい
Visual Basic(VBA)
-
12
VBAでエクセルシートを更新(リフレッシュ)する方法を教えて下さい。
Excel(エクセル)
-
13
ユーザーフォームを表示中にシートの操作をさせるには
Excel(エクセル)
-
14
メッセージボックスのOKボタンをVBAでクリックさせたい
Visual Basic(VBA)
-
15
VBAで、なぜかSendkeyが効きません。
PowerPoint(パワーポイント)
-
16
VBA(エクセル)で自動的にボタンをクリックさせるには
その他(プログラミング・Web制作)
-
17
AccessのFormのみをスクリーンショットでとりたい
その他(データベース)
-
18
「Columns(A:C")」の列文字を数字にして表記したい"
Excel(エクセル)
-
19
VBA:ユーザーフォームのマルチページに色を付けたい。
Word(ワード)
-
20
エクセルVBAでUserFormを起動した時
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Windowsで縦に長いページを全て...
-
iPhoneの画面が見切れて困って...
-
【VBA】 Alt+PrintScreenにて...
-
outlook メモリ不足
-
PCでスクリーンショットを撮っ...
-
iOS11でスクリーンショットを無...
-
スクリーンショットのやり方を...
-
プリントスクリーンについて
-
I TUNES
-
Windows10、スクショット(はさ...
-
いちいち最大化
-
PRAMおよびNVRAMをリセットする...
-
Googleマップの ストリートビ...
-
モニター画面をコピー
-
アイフォーン以外にもスクリー...
-
再起動後BIOS画面から画面が乱れる
-
Windows7のショートカットキー無効
-
この画面をスクリーンショット...
-
勘定科目を教えてください
-
対向装置とは、どんな装置でし...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
iPhoneの画面が見切れて困って...
-
Windowsで縦に長いページを全て...
-
【VBA】 Alt+PrintScreenにて...
-
Googleマップの ストリートビ...
-
outlook メモリ不足
-
パソコンの画面を全面にする方法
-
ペイントへのスクリーンショッ...
-
Windowsのスクリーンショットの...
-
どうしてもスクリーンショット...
-
DVD動画から静止画を取り出す方...
-
サンリオピューロランド
-
Windows10での外部モニタの解像...
-
bingチャットの内容(縦長)をス...
-
画面配色の変更方法
-
CapsLockを押す度に出てくる表...
-
スクリーンショットについて
-
OSのバージョン
-
bootcampで、スクリーンショッ...
-
スクリーンショットの保存場所...
-
Applescriptで一番上のウィンド...
おすすめ情報