Ofice2019の環境です。
スライドショー実行中の画面を印刷したくて
PrintScreen(API)を使ったコードを作りました。
実行中の任意のタイミングで印刷するために動作設定ボタン(Caption:画面印刷)を配置しました。
動作設定ボタンには、マクロを実行するようにしてあります。
問題は、
画面印刷すると、同さ設定ボタンも印刷されてしまいので、
PrintScreenを実行する前に、動作設定ボタンを非表示にしているのですが、
なぜか、動作設定ボタンが表示状態で印刷されます。
DoEventsをかませたり、Sleep(3〜10秒)で時間調整、ボタンの移動、透明化など試みたが、効き目なしです。
そもそも、低速なVBAとの相性がよくないのでしょうか?
以下が作成したコードです。添削をお願いします。
#If VBA7 And Win64 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms 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)
#Else
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)
#End If
Private Const KEYEVENTF_EXTENDEDKEY As Long = &H1
Private Const KEYEVENTF_KEYUP As Long = &H2
Private Const VK_LMENU As Long = &HA4
Private Const fKEYDOWN = KEYEVENTF_EXTENDEDKEY
Private Const fKEYUP = KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP
Private xlApp As Object
Const xlLandscape = 2
Sub PrtSc()
Dim shape As shape, S As Long
S = SlideShowWindows(1).View.CurrentShowPosition
For Each shape In Application.ActivePresentation.Slides(S).Shapes
If shape.Type = 1 And shape.HasTextFrame Then
If shape.TextEffect.Text = "画面印刷" Then
shape.Visible = msoFalse
Exit For
End If
End If
Next
DoEvents
Sleep 3000
keybd_event VK_LMENU, 0&, fKEYDOWN, 0&
keybd_event vbKeySnapshot, 0&, fKEYDOWN, 0&
keybd_event vbKeySnapshot, 0&, fKEYUP, 0&
keybd_event VK_LMENU, 0&, fKEYUP, 0&
DoEvents
Set xlApp = CreateObject("Excel.Application")
With xlApp
.ScreenUpdating = False
.Visible = True
With .workbooks.Add
With .sheets(1)
.Paste
xlApp.cutcopymode = False
.Shapes(1).ScaleWidth 0.64, False
.PageSetup.Orientation = xlLandscape
.PrintOut
End With
.Close False
End With
.Quit
End With
Set xlApp = Nothing
shape.Visible = msoTrue
End Sub