WinArrow's Web ARENAのWinArrowさんから提供いただいたコードです。ありがとうございます♪m(_
_)m
ユーザーフォームに【CommandButton1】を配置して押すと、【Sheet1】A1セルにユーザーフォームが貼り付きます。
Win9x系(95/98/ME)用 (Win2000では、シート全体が図として貼り付きます)' 【標準モジュール】
Public Declare Sub
keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Public Const VK_SNAPSHOT = &H2C
Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
このコードの使い方は、マクロの使い方(１)標準モジュールにあります。
' 【フォームのコマンドボタン】
Private Sub
CommandButton1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
Call keybd_event(VK_SNAPSHOT, 0,
KEYEVENTF_EXTENDEDKEY, 0)
Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY
Or KEYEVENTF_KEYUP, 0)
DoEvents
Unload Me
'貼り付け
Range("A1").Select
ActiveSheet.Paste
'イメージ選択を解除
Range("A1").Select
'印刷方向を横に変える
With
Sheets("Sheet1").PageSetup
.Orientation = xlLandscape
End With
'印刷プレビュー
ActiveWindow.SelectedSheets.PrintPreview
End Sub
このコードの使い方は、マクロの使い方(４)ユーザーフォームのモジュールにあります。
|
| Win9x系、WinNT系判別処理付きのバージョン ' 【標準モジュール】
Option Explicit
Public Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Public Const VK_LMENU = &HA4
Public Const VK_SNAPSHOT = &H2C
Public Const VK_CONTROL = &H11
Public Const VK_V = &H56
Public Const VK_0x79 = &H79
Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
このコードの使い方は、マクロの使い方(１)標準モジュールにあります。
' 【フォームのコマンドボタン】
Dim OSV As String
Private Sub CommandButton2_Click()
' フォームを閉じる
Unload Me
End Sub
Private Sub UserForm_Activate()
'
ＯＳ情報（バージョン）を取得
OSV =
Application.OperatingSystem
End Sub
Private Sub CommandButton1_MouseDown(ByVal Button As
Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
' ＯＳ情報の18桁目〜2桁＝"NT"を判別して、Win32APIインタフェースを切り分け
'
ユーザーフォームを画像としてシートに貼り付ける。
' Win32API（PrintScreenキー使用）
If Mid(OSV, 18, 2) =
"NT" Then
' WinNT系のWin32APIインタフェース
Call
keybd_event(VK_LMENU, VK_V, KEYEVENTF_EXTENDEDKEY, 0)
Call keybd_event(VK_SNAPSHOT, VK_0x79,
KEYEVENTF_EXTENDEDKEY, 0)
Call keybd_event(VK_LMENU, VK_V,
KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
Call keybd_event(VK_SNAPSHOT, VK_0x79,
KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
Else
' Win9x系のWin32APIインターフェース
Call
keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0)
Call keybd_event(VK_SNAPSHOT, 0,
KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
End If
DoEvents
Unload Me
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
'
印刷用用紙Ａ４横向き設定
With
Sheets("Sheet1").PageSetup
.Orientation = xlLandscape
End With
' 印刷プレビュー
ActiveWindow.SelectedSheets.PrintPreview
End Sub
このコードの使い方は、マクロの使い方(４)ユーザーフォームのモジュールにあります。
|