Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

36127 / 76738

←次へ　｜　前へ→


	【45794】Re:エクセル

Kein - 07/1/14(日) 16:57 -


	引用なし

	パスワード

ファイルを開く必要はありますが、アクティブシートのスナップショットを
画像ファイルに落として、ネットワーク越しに相手のマシンのルートフォルダーへ
送る。ということは出来ます。以下のマクロを標準モジュールの先頭から入れて
>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

0 hits

▼

【45784】エクセル kyuzou 07/1/14(日) 11:31