下記の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も見ています
-
性格の違いは生まれた順番で決まる?長男長女・中間子・末っ子・一人っ子の性格の傾向
同じ環境で生まれ育っても、生まれ順で性格は違うものなのだろうか。家庭教育研究家の田宮由美さんに教えてもらった。
-
エクセルのVBAでクリップボードにコピーした画像をpng(or jpg or bmp)保存したい
Visual Basic(VBA)
-
【マクロ】プリントスクリーンした画像をエクセルに貼付して印刷したい
Excel(エクセル)
-
アクセスの画面をプリントスクリーンでとる方法
その他(ソフトウェア)
-
-
4
VBAで既に開いている別アプリケーションのオブジェクトを得る
Visual Basic(VBA)
-
5
フォームをBMPで保存
Visual Basic(VBA)
-
6
VBA(エクセル)で自動的にボタンをクリックさせるには
その他(プログラミング・Web制作)
-
7
VBAで保存しないで閉じると空のBookが残る
Excel(エクセル)
-
8
AccessのFormのみをスクリーンショットでとりたい
その他(データベース)
-
9
エクセルのラベルの値(文字列)を垂直方向で中央揃えにするには?
Excel(エクセル)
-
10
Excel ユーザーフォームで表示させた画像をユーザーフォーム上で保存したい
Visual Basic(VBA)
-
11
エクセル:マクロ「Application.CutCopyMode = False」って?
Excel(エクセル)
-
12
【エクセルのマクロ】クリップボードのbitmapをフォームに表示させたい
Visual Basic(VBA)
-
13
VBAで、なぜかSendkeyが効きません。
PowerPoint(パワーポイント)
-
14
メッセージボックスを前面に表示させるには?
Visual Basic(VBA)
-
15
VBAのコマンドボタンの文字列の改行方法は?
Visual Basic(VBA)
-
16
メッセージボックスのOKボタンをVBAでクリックさせたい
Visual Basic(VBA)
-
17
PrintFormを使用してのプリント
Visual Basic(VBA)
-
18
エクセルVBA テキストボックスに3桁ごとにコンマ
Visual Basic(VBA)
-
19
エクセルvbaでの図形のカット(コピー)ペーストについて
Excel(エクセル)
-
20
VBAで任意のウインドウのサイズを変更する方法
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
iPhoneの画面が見切れて困って...
-
【VBA】 Alt+PrintScreenにて...
-
CapsLockを押す度に出てくる表...
-
Virtual PC2004
-
どうしてもスクリーンショット...
-
Windowsで縦に長いページを全て...
-
windows powershellのコンソー...
-
VBAにてスクリーンショットをク...
-
outlook メモリ不足
-
Googleマップの ストリートビ...
-
ペイントへのスクリーンショッ...
-
DVD動画から静止画を取り出す方...
-
ここの回答にYahooの知恵袋の回...
-
スクリーンショット 方法 保存 ...
-
勘定科目を教えてください
-
対向装置とは、どんな装置でし...
-
PC Helpsoft DriverUpdater
-
Gmailをパソコンでも見る方法
-
アダルトサイトから、勝手に保...
-
VAIO RA70-Pのハードディスクを...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【VBA】 Alt+PrintScreenにて...
-
iPhoneの画面が見切れて困って...
-
Googleマップの ストリートビ...
-
Windowsで縦に長いページを全て...
-
outlook メモリ不足
-
どうしてもスクリーンショット...
-
Windows11でスクショする方法が...
-
windows powershellのコンソー...
-
ペイントへのスクリーンショッ...
-
DVD動画から静止画を取り出す方...
-
CapsLockを押す度に出てくる表...
-
ここの回答にYahooの知恵袋の回...
-
設定画面を元に戻すにはどうす...
-
クリップボードの容量について
-
CentOS7のインストーラでキャプ...
-
bingチャットの内容(縦長)をス...
-
コマンドラインでスクリーンシ...
-
Macでの画面コピー
-
サンリオピューロランド
-
Uber eats 配達員の報酬につい...
おすすめ情報