|
ファイルを開く必要はありますが、アクティブシートのスナップショットを
画像ファイルに落として、ネットワーク越しに相手のマシンのルートフォルダーへ
送る。ということは出来ます。以下のマクロを標準モジュールの先頭から入れて
>WshShell.CurrentDirectory = "\\IBM\F"
を相手先に変更してから任意のシートを開き、実行して下さい。
作成されるファイル名は、"ExcelSt" & 現在の日時 & ".jpg" です。
Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Const VK_SNAPSHOT = &H2C
Sub Mk_Excel_SShot()
Dim WshShell As Object
Dim DefP As String, DvN As String, XLSc As String
Set WshShell = CreateObject("WScript.Shell")
On Error Resume Next
WshShell.CurrentDirectory = "\\IBM\F"
If Err.Number <> 0 Then
MsgBox "コピー先PCがLANに接続されていません", 48
Set WshShell = Nothing: Exit Sub
Else
MsgBox "アクティブウィンドウのスナップショットを" & _
vbLf & "画像ファイルにして送ります。", 64
End If
On Error GoTo 0
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
DoEvents
Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0)
DoEvents
With Application
If IsError(.Match(xlClipboardFormatBitmap, _
.ClipboardFormats, 0)) Then
MsgBox "スクリーンショットは失敗しました", 48: GoTo ELine
End If
End With
XLSc = WshShell.CurrentDirectory & "\ExcelSt" & _
Format(Now(), "yymmdd_hhmm") & ".jpg"
With Charts.Add
.Paste
.Export XLSc, "JPEG"
.Delete
End With
ELine:
With Application
.CutCopyMode = False
.DisplayAlerts = True
.ScreenUpdating = True
DefP = .DefaultFilePath
End With
DvN = Left$(DefP, InStr(1, DefP, "\")): ChDrive DvN
WshShell.CurrentDirectory = DefP: Set WshShell = Nothing
End Sub
|
|