プロが教えるわが家の防犯対策術!

タイトルの件、下記のマクロ【コールステイトメント】をご覧ください。
同マクロが

●添付画像1の場合
⇒白紙のエクセルの場合は動く

●添付画像2の場合
⇒エクセル上にマクロボタンを付けた場合
⇒動かない

です。

解決方法をご存じの方は教えて下さい。

【エラー内容】
下記がデバックとなります。トリミングのマクロです。
.PictureFormat.CropTop = OffTop


【マクロ コールステイトメント内容】
Sub コール()

'プリントスクリーンボタンを押し、スクショを取って、エクセルに貼付する
Call スクショ貼付

'撮ったスクショを、自由なサイズにトリミングする
Call トリミング

'トリミングしたスクショを、自由なサイズに変更する
Call サイズ調整

'変更したサイズを印刷する
Call 印刷

End Sub

4つのマクロのコードです↓↓↓

【スクショ貼付】
'キーボードイベント用のライブラリ読み込み
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 スクショ貼付()
keybd_event vbKeySnapshot, 0&, fKEYDOWN, 0&

keybd_event vbKeySnapshot, 0&, fKEYUP, 0&

Application.Wait Now() + TimeValue("00:00:01")

Range("A1").Select

ActiveSheet.Paste

Selection.Copy




End Sub

【トリミング】
Sub トリミング()
Const OffTop As Double = 0 '上の切り取り
Const OffLeft As Double = 0 '左の切り取り
Const OffBottom As Double = 0 '下の切り取り
Const OffRight As Double = 500 '右の切り取り
Dim ws As Worksheet
Dim sp1 As Shape
Set ws = ActiveSheet
Set sp1 = ws.Shapes(1)
With sp1
.PictureFormat.CropTop = OffTop
.PictureFormat.CropLeft = OffLeft
.PictureFormat.CropBottom = OffBottom
.PictureFormat.CropRight = OffRight
End With
End Sub

【サイズ調整】
Sub サイズ調整()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(1)

With shp
.LockAspectRatio = msoFalse
.Height = ActiveSheet.Range("1:30").Height
.Width = ActiveSheet.Range("a:ao").Width
End With
End Sub



【印刷】
Sub 印刷()

Worksheets("ボタンなし").PrintOut

End Sub

「【マクロ】スクショ印刷がうまく動かない件」の質問画像

質問者からの補足コメント

  • Qchan1962 様

    ご指導ならびにコード教授のおかげて
    完成しました。本当にありがとうございます。


    うまくいったコード書きたいのですが、文字数オーバーにてかけませんでした。

      補足日時:2022/12/07 10:32

A 回答 (5件)

ひょっとして


ActiveSheet と Worksheets("ボタンなし") は同じではない?
スクショの取るタイミングも気になります・・が
違うシートなら
Sub スクショ貼付()
keybd_event vbKeySnapshot, 0&, fKEYDOWN, 0&
keybd_event vbKeySnapshot, 0&, fKEYUP, 0&
Application.Wait Now() + TimeValue("00:00:01")
Set ws = Worksheets("ボタンなし")
ws.Select
With ws
.Range("A1").Select
.Paste
'Selection.Copy
Set sp1 = .Shapes(.Shapes.Count)
End With
End Sub

念のため
'【サイズ調整】
.LockAspectRatio = msoFalse
.Height = ws.Range("1:30").Height
.Width = ws.Range("a:H").Width
が良いかも
    • good
    • 0
この回答へのお礼

今、ちょっと、NO4回答をためしましたが、動きませんでした。

しかし、Qchanさんは動いたとのことで検証して
質問をまとめている最中です。

ボタンなしシートとアクティブシートは違います。

具体的には

ボタンなしシートでは動きます。
これは使いたくないです。

ボタンがあるシートで実行できるようにしたいのです
理由はそのボタンに、本コールステイトメントを登録して
ボタンを押せば、コールステイトメントが実行されるように
したいからです。

お礼日時:2022/12/06 21:19

こんな感じでしょうか


ActiveSheet.Range("a:H").Widthでテストしました

'【スクショ貼付】
'キーボードイベント用のライブラリ読み込み
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 コール()

'プリントスクリーンボタンを押し、スクショを取って、エクセルに貼付する
Call スクショ貼付

'撮ったスクショを、自由なサイズにトリミングする,自由なサイズに変更する
Call トリミングサイズ調整

'変更したサイズを印刷する
Call 印刷

End Sub

'4 つのマクロのコードです↓↓↓

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

'【トリミングサイズ調整】
Sub トリミングサイズ調整()
Const OffTop As Double = 0 '上の切り取り
Const OffLeft As Double = 0 '左の切り取り
Const OffBottom As Double = 0 '下の切り取り
Const OffRight As Double = 500 '右の切り取り

With sp1
.PictureFormat.CropTop = OffTop
.PictureFormat.CropLeft = OffLeft
.PictureFormat.CropBottom = OffBottom
.PictureFormat.CropRight = OffRight
'【サイズ調整】
.LockAspectRatio = msoFalse
.Height = ActiveSheet.Range("1:30").Height
.Width = ActiveSheet.Range("a:H").Width

End With
End Sub

'【印刷】
Sub 印刷()
ws.PrintOut
End Sub
    • good
    • 0
この回答へのお礼

12/6/21:25最新投稿です
トリミングサイズ調整が動きません。

エラーは下記のとおりです。

コールステイトメントでも、トリミングサイズ調整単体の
SUBで実行しても、エラーとなります。

お手すきな時に、ご教授をお願いします。


【トリミングサイズ調整コード】
Sub トリミングサイズ調整()
Const OffTop As Double = 0 '上の切り取り
Const OffLeft As Double = 0 '左の切り取り
Const OffBottom As Double = 0 '下の切り取り
Const OffRight As Double = 500 '右の切り取り

With sp1
.PictureFormat.CropTop = OffTop
.PictureFormat.CropLeft = OffLeft
.PictureFormat.CropBottom = OffBottom
.PictureFormat.CropRight = OffRight
'【サイズ調整】
.LockAspectRatio = msoFalse
.Height = ws.Range("1:30").Height
.Width = ws.Range("a:H").Width

End With
End Sub




【エラー】
.PictureFormat.CropTop = OffTop
'トリミングサイズ調整のSUBにあるコードです

【コールステイトメント】
Sub コール()

Call スクショ貼付
Call トリミングサイズ調整
Call 印刷

End Sub

お礼日時:2022/12/06 21:28

>今度は、トリミングは出来たのですがサイズ調・・


トリミング処理に入れてしまえば・・と思いますがSubを分けている意味が御有りなのでしょうから・・分けるとして

同じShapeを対象にするのなら 変数スコープをモージュールレベルに変更して
同じ変数を使用するのはいかがでしょう

Dim sp1 As Shape
Sub コール()
・・
End Sub
Sub トリミング()


Dim ws As Worksheet
Set ws = ActiveSheet
Set sp1 = ws.Shapes(ws.Shapes.Count)


End Sub

Sub サイズ調整()
With sp1
.LockAspectRatio = msoFalse
.Height = ActiveSheet.Range("1:30").Height
.Width = ActiveSheet.Range("a:ao").Width
End With
End Sub

試していないのでダメでしたらごめんなさい
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
試しましたが

サイズ調整のところでやはりエラーとなります
エラー↓
.LockAspectRatio = msoFalse

ちなみに、SUBを分けているのは、知識がないので
1つ1つ作って、callステートメントにてつないでいます。

知識があれば、1つのSUBに全て入れれば良いと思っています。
また、お手すきな時、サイズ調整のコードをご教授願います。

お礼日時:2022/12/06 20:08

こんばんは


#1様がすでに回答済みですので、通常の対策コードだけですが
Set sp1 = ws.Shapes(1) を
Set sp1 = ws.Shapes(ws.Shapes.Count)に変更してみてください

最後に追加されたShapeがセットできると思います
    • good
    • 0
この回答へのお礼

回答ありがとうございます。

Qchan1962さんのご指摘とおり実施し動きましたが

今度は、トリミングは出来たのですが
サイズ調整、下記マクロは実施されませんでした。
エラーはありません。

Set shp = ActiveSheet.Shapes(1)

上記のShapes(1)を ws.Shapes(ws.Shapes.Count)に変更しましたが
できませんでした。エラーとなります。

大変、お手数ですが、ご指導お願いします

【サイズ調整】
Sub サイズ調整()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(1)

With shp
.LockAspectRatio = msoFalse
.Height = ActiveSheet.Range("1:30").Height
.Width = ActiveSheet.Range("a:ao").Width
End With
End Sub

お礼日時:2022/12/06 19:25

こんばんは



情報が不足しているので、断言はできませんが・・

>⇒エクセル上にマクロボタンを付けた場合
>⇒動かない
対象の図形を
>Set sp1 = ws.Shapes(1)
と決め打ちにしているので、ボタンを取得しているのではないかと推測します。
ウォッチ式などで、Shapes(1)の実態が何かを確認すればわかるのではないでしょうか。

エラーメッセージが「そのようなプロパティはない」といった内容ではないかと推測しますが、
「PictureFormatプロパティは画像または OLE オブジェクトに適用されます」
となっていますので、ボタンをそれ以外で作成しているってことではないでしょうか?
https://learn.microsoft.com/ja-jp/office/vba/api …
    • good
    • 0
この回答へのお礼

お返事ありがとうございます。

対象の図形を
>Set sp1 = ws.Shapes(1)
と決め打ちにしているので、ボタンを取得しているのではないかと推測します。

⇒ボタンの画像を取得しているのでしょうか。
⇒希望は、スクショした画像をトリミング⇒サイズ調整⇒印刷と
⇒したいのです。

難しいですかね

お礼日時:2022/12/06 18:38

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!