[[20150810091908]]　『マクロ：エクセルの表をペイントに貼り付け』（スヌーピー）　ページの最後に飛ぶ

『マクロ：エクセルの表をペイントに貼り付け』（スヌーピー）

マクロで質問です。

エクセルの表

   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

画像としてではなくそのまま貼り付け
Sub Test2()

    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

コメント返信：

[ 一覧(最新更新順) ]

[[20150810091908]] 『マクロ：エクセルの表をペイントに貼り付け』（スヌーピー） ページの最後に飛ぶ

[[20150810091908]]　『マクロ：エクセルの表をペイントに貼り付け』（スヌーピー）　ページの最後に飛ぶ