[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロ:エクセルの表をペイントに貼り付け』(スヌーピー)
マクロで質問です。
エクセルの表
A B C 1 もも 100 3 2 みかん 100 4 3 すいか 200 5 4 バナナ 200 6
A1からC4をコピーしてペイントに貼り付けをしたいのですが、
マクロで実行することは可能でしょうか。
宜しくお願いいたします。
< 使用 Excel:Excel2013、使用 OS:Windows7 >
↓でいけます。 罫線もコピーされるので、必要に応じて罫線を非表示にして 試してください。
範囲選択してコピー ↓ 貼り付け ↓ 図 ↓ 図として貼り付け
出来た図をコピー ↓ ペイント起動 ↓ ペイント上で右クリック ↓ 貼り付け (カリーニン) 2015/08/10(月) 09:55
↑罫線ではなく、枠線でした。 (カリーニン) 2015/08/10(月) 09:56
上記をマクロで実行したいのですが、
可能でしょうか。
(スヌーピー) 2015/08/10(月) 09:59
マクロでしたか。
コピーしたものを画像ファイルとして保存するところまでは エクセルVBAで出来ると思いますが、ペイントに貼り付けると なると、エクセルにとってペイントは外部アプリケーションなので 出来るかはわかりません。
API使用するとできるのかもしれませんが。 (カリーニン) 2015/08/10(月) 10:02
Dim lngTaskID As Long lngTaskID = Shell("mspaint.exe", vbNormalFocus)
どなたかご教示願います。
(スヌーピー) 2015/08/10(月) 10:34
自分がアドインにしているのは、
Sub SavePaint()
Dim taskID As Double, pauseTime As Double Dim start As Date Dim selectObj As Object Dim f As String
f = ActiveWorkbook.Name f = Left(f, InStr(1, f, ".xls") - 1) f = f & Format(Now(), "[$-411]ggge""年""m""月""d""日 ""h""時""mm""分""")
Call SaveImage(ActiveWorkbook.Path & "\" & f & ".jpg")
End Sub
Public Sub SaveImage(ByVal argSavePath As String)
Dim rg As Range Dim cht As Chart Dim fina As String
'保存ファイル名を取得 fina = argSavePath
If fina <> "" Then '選択範囲を取得 Set rg = Selection '選択した範囲を画像形式でコピー rg.CopyPicture appearance:=xlScreen, Format:=xlPicture '画像貼り付け用の埋め込みグラフを作成 Set cht = ActiveSheet.ChartObjects.Add(0, 0, rg.Width, rg.Height).Chart '埋め込みグラフに貼り付ける cht.Paste 'JPEG形式で保存 cht.Export Filename:=fina, filtername:="JPG" '埋め込みグラフを削除 cht.Parent.Delete End If End Sub Public Sub SaveSelectionAsImage(ByVal argSavePath As String) Dim m_Width As Double, m_Height As Double
If Len(argSavePath) > 0 Then Application.ScreenUpdating = False Selection.CopyPicture xlPrinter, xlPicture ActiveSheet.Paste With Selection m_Width = .Width + 8: m_Height = .Height + 8 .CopyPicture xlPrinter, xlPicture .Delete End With On Error Resume Next With ActiveSheet.ChartObjects.Add(0, 0, m_Width, m_Height).Chart .Paste .ChartArea.Border.LineStyle = 0 .Export argSavePath, "JPEG" .Parent.Delete End With On Error GoTo 0 Application.ScreenUpdating = True End If End Sub
こんな感じで画像として保存していますので、そのファイルをペイントで開くのではダメでしょうか?
(ウッシ) 2015/08/10(月) 10:51
Dim lngTaskID As Long Range("A1:C4").Copy lngTaskID = Shell("mspaint.exe", vbNormalFocus) Application.Wait Now + TimeValue("00:00:01") AppActivate lngTaskID SendKeys "^v" End Sub
(デイト) 2015/08/10(月) 10:53
ご教示いただきありがとうございました。
(スヌーピー) 2015/08/10(月) 12:45
こちらもお忘れなく。
[[20150807102154]] 『エクセルのマクロでACCESSマクロを実行する』(スヌーピー)
(ホー・チ・ジン) 2015/08/12(水) 00:01
以前、デイトさんにご教示いただきましたペイントの貼り付けマクロですが、
初めてこの作業を行うと、
AppActivate lngTaskID の部分でデバックしてしまいます。
2回目以降はうまく実行されるのですが。
解消方法はありますでしょうか。
宜しくお願いいたします。
(スヌーピー) 2016/05/23(月) 13:39
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.