2003VBAでペイントを操作する

Excel2003で、表をコピーしてペイントに張り付け、図に変換しエクセルに張り付けようとしています。OSはwin7proです。バージョンは、これで正解かわかりませんが、6.1.7601 servicepack1 ビルド7601です。
会社で設備付けパソコンのため、アップデートはしていません。
インターネットで調べて、以下のように作ってみました。SendKeysのところで
『実行エラー　７０　書き込みできません』で止まります。

Dim　rc As long
Dim v,a,c,F4
Sheet("データ収集”）.select
Range("B51:L55").select
rc=Shell("mspait.exe".VbNormalNoFocus)
Application Wait Now+TimeValue("0:00:01")
SendKeys"(^v)",wait
Sendkeys"(^a)",wait
SendKeys"(^c)",wait
SendKeys"(%F4)",wait
Sheet("データ収集”）.select
,
,続く

SendKeysで検索すると、Send○○とかCall Send○○とか書かれているのですが動きません。2003とwin７との組み合わせがよくないようなことも書かれているようですが、書いてあることが難しくてよくわかりません。

VBAは、インターネットからコピペして使用する程度で、くわしいことはわかっていません。質問も初めてです。素人で申し訳ありませんが、ご教授いただければ幸いです。

shinobu_osaka

2019/01/17 10:51

このコード、動きます？３箇所構文ミスがありますし、何より選択したセルをコピーするところがないんですが。どのようなコピーをしたいのか？CopyPicture？そうであれば普通に貼り付ければいいのになぜ一旦ペイントに貼り付けるのでしょう？もしもう他の方の回答で解決してるのならベストアンサーをつけるようにしましょう。

行動規範の内容に同意します

回答4件

図(絵)として貼るのが目的ならば、ペイントを呼んだりせずとも、下記のようにExcelだけで完結できなくもないです。
手元にExcel2003が無いので動作するか未確認ですが、CopyPictureメソッドはあるようなので動作するのではないでしょうか。

貼り付け後のサイズやら何やらが違ったりするのは全く考慮していませんし、その辺を貼り付け後に調整するならもう少しコードに工夫が必要ですが参考まで。

VBA
1    Range("B51:L55").CopyPicture
2    Range("B60").PasteSpecial

投稿2019/01/16 14:19

退会済みユーザー

総合スコア0

teruo

2019/01/17 14:23

回答ありがとうございました。 CopyPictureはExcel2003では、サポートしていませんとエラーが出ます。これができると、簡単なんですが。。。

退会済みユーザー

2019/01/20 02:42

Excel2003がある環境を触る機会がありましたので試しましたが、そのまま使えましたよ。細かなパッチレベルは確認しませんでしたが、SP3は当たっていました。

行動規範の内容に同意します

自己解決

貼り付け先の列数が足りず、図で張り付け縮小させようとしていました。
これができると、手間も少なく良かったのですが無理なようです。
今回は、貼り付け先を工夫して、セルでコピーできるようにしていきます。

投稿2019/01/17 14:18

teruo

総合スコア6

これまでなんどもSendKeysを使ってきましたが、このエラーが発生したことはないですね。。

でも「sendkeys vba 実行エラー 70」で検索するといろいろでてきました。

どうやらWindowsVista以降のセキュリティ強化の影響のようで、
・当該セキュリティ設定(UAC)を無効にする（非推奨）
・SendInputを利用する
といった回避策があるようです。

さしあたり
⇒Windows7で VB6 / VBA の SendKeys の問題について - アプリ仮想化奉行
 ⇒SendInputにてキーを送る - Yahoo知恵袋
などが参考になるでしょうか？

追記①　SendInputでペイントを操作する

紹介した記事が難しかったとのことですので補足させていただきます。

SendInputはSendKeysに比べると少しやりとりが面倒です。

例えば[Ctrl]+[V]というキー入力を送信する場合、SendKeysでは

SendKeys "^(v)", Wait   '[Ctrl]を押しながら[V]

という一文でできますが、SendInputでは

    '--[CTRL]キーダウン
    With inputevents(0)
        .dwType = INPUT_KEYBOARD
        .ki.wVk = VK_CTRL
        .ki.wScan = 0
        .ki.dwFlags = KEYEVENTF_KEYDOWN
        .ki.time = 0
        .ki.dwExtraInfo = 0
    End With
    '--[V]キーダウン
    With inputevents(1)
        .dwType = INPUT_KEYBOARD
        .ki.wVk = VK_V
        .ki.wScan = 0
        .ki.dwFlags = KEYEVENTF_KEYDOWN
        .ki.time = 0
        .ki.dwExtraInfo = 0
    End With
    '--[V]キーアップ
    With inputevents(2)
        .dwType = INPUT_KEYBOARD
        .ki.wVk = VK_V
        .ki.wScan = 0
        .ki.dwFlags = KEYEVENTF_KEYUP
        .ki.time = 0
        .ki.dwExtraInfo = 0
    End With
    '--[CTRL]キーアップ
    With inputevents(3)
        .dwType = INPUT_KEYBOARD
        .ki.wVk = VK_CTRL
        .ki.wScan = 0
        .ki.dwFlags = KEYEVENTF_KEYUP
        .ki.time = 0
        .ki.dwExtraInfo = 0
    End With
    
    SendInput 4, inputevents(0), Len(inputevents(0))    '配列に格納した4つの操作を実行

といった具合に、各キーのキーダウン、キーアップのタイミングを考慮しながら操作用の配列を作成し、それをまとめて実行する、といった手順になります。
ちなみに、１つの操作ごとにSendInputを実行（計4回SendInputする）でも同じ結果が得られます。

非常に長いコードに見えますが、操作用の配列の中身は「入力キー」と「キーアップ/ダウン」の部分しか変更しておらず、他は同じ内容を毎回記述しています。
これがコードが長く見ずらい原因となっていますので、以下のサンプルコードのように関数化して使用すると操作が多少楽になります。

'標準モジュール
Public Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As INPUT_TYPE, ByVal cbsize As Long) As Long

Public Type KEYBDINPUT
    wVk As Integer
    wScan As Integer
    dwFlags As Long
    time As Long
    dwExtraInfo As Long
    dummy1 As Long
    dummy2 As Long
End Type

Public Type INPUT_TYPE
    dwType As Long
    ki As KEYBDINPUT
End Type

'キー定数
Public Const INPUT_KEYBOARD As Integer = 1

Public Const VK_TAB As Integer = &H9    'Tab
Public Const VK_ENTER As Integer = &HD  'Enter

Public Const VK_SHIFT = &H10            'Shift
Public Const VK_CTRL = &H11             'Contorol
Public Const VK_ALT = &H12              'Alt

Public Const VK_A = &H41           '「A」
Public Const VK_C = &H43           '「C」
Public Const VK_V = &H56           '「V」

Public Const VK_F4 = &H73           'F4

Public Const KEYEVENTF_KEYDOWN As Integer = 0
Public Const KEYEVENTF_KEYUP As Integer = 2

'メイン関数
Sub SampleMain()
    Dim rc As Long
    ThisWorkbook.Worksheets("データ収集").Range("B51:L55").Copy
    
    'ペイント起動
    rc = Shell("C:\Windows\System32\mspaint.exe", vbNormalFocus)    '以降の処理でアクティブにしていないのならここでフォーカスを与える必要がある
    '起動待ち１秒
    Application.Wait Now + TimeValue("0:00:01")
    
    '●貼り付け
    prcSendInput VK_CTRL, KEYEVENTF_KEYDOWN     '[CTRL]キーダウン
    prcSendInput VK_V, KEYEVENTF_KEYDOWN        '[V]キーダウン
    prcSendInput VK_V, KEYEVENTF_KEYUP          '[V]キーアップ
    prcSendInput VK_CTRL, KEYEVENTF_KEYUP       '[CTRL]キーアップ
    '●全選択
    prcSendInput VK_CTRL, KEYEVENTF_KEYDOWN     '[CTRL]キーダウン
    prcSendInput VK_A, KEYEVENTF_KEYDOWN        '[A]キーダウン
    prcSendInput VK_A, KEYEVENTF_KEYUP          '[A]キーアップ
    prcSendInput VK_CTRL, KEYEVENTF_KEYUP       '[CTRL]キーアップ
    '●コピー
    prcSendInput VK_CTRL, KEYEVENTF_KEYDOWN     '[CTRL]キーダウン
    prcSendInput VK_C, KEYEVENTF_KEYDOWN        '[C]キーダウン
    prcSendInput VK_C, KEYEVENTF_KEYUP          '[C]キーアップ
    prcSendInput VK_CTRL, KEYEVENTF_KEYUP       '[CTRL]キーアップ
    '●終了
    prcSendInput VK_ALT, KEYEVENTF_KEYDOWN      '[ALT]キーダウン
    prcSendInput VK_F4, KEYEVENTF_KEYDOWN       '[F4]キーダウン
    prcSendInput VK_F4, KEYEVENTF_KEYUP         '[F4]キーアップ
    prcSendInput VK_ALT, KEYEVENTF_KEYUP        '[ALT]キーアップ
    
    MsgBox "Paste?"
    ThisWorkbook.Worksheets("データ収集").Range("A1").PasteSpecial
End Sub

'SendInputを簡易化した関数
Sub prcSendInput(VkKey As Integer, UpDown As Integer)
    Dim inputevents(1) As INPUT_TYPE
    
    With inputevents(0)
        .dwType = INPUT_KEYBOARD
        .ki.wVk = VkKey
        .ki.wScan = 0
        .ki.dwFlags = UpDown
        .ki.time = 0
        .ki.dwExtraInfo = 0
    End With
    SendInput 1, inputevents(0), Len(inputevents(0))    '配列に格納した1つの操作を実行
End Sub

追記②　Excel上でセル範囲を図としてコピペする

「エラーの原因や回避策は後回しでいいから、とにかく目的が実現したいのだ！」
という状況なのかもしれないので、別方向からのアプローチも提案してみます。

下記参考サイトですが、これは質問者さんの環境ではエラーとなったというCopyPictureメソッドの解説ページです。
参考⇒セル範囲を画像としてコピーする(CopyPictureメソッド)｜Excel VBA

上記の記事内に、以下のような記載があります。
＞Excel 2007以降の［ホーム］タブ→［貼りつけ］→［図］→［図としてコピー］の機能、
＞Excel 2003以前の［Shift］キーを押しながら[編集]メニューを選択した時に表示される[図のコピー]の機能と同じです。

これをマクロの記録でVBAコードにしてみましょう。

この操作を実際にシート上で行いそれを「マクロの記録」してみると、記録されたVBAではCopyPictureメソッドは使用されていませんでした。(当方の環境Windows7/Office2010での結果です)

記録されたのは、要約すると下記のようなコードでした。

'対象範囲をコピー
Range("B51:L55").Copy
'貼り付け先を選択
Range("B1").Select
'コピーしたセル範囲を「図として貼り付け」
ActiveSheet.Pictures.Paste.Select

つまりセル範囲を普通にコピーして「図として貼り付け」ています。（そのままですね。）

解決済みではありますが、まだ模索を続けられているようでしたらこちらも試してみてはいかがでしょうか。
参考になれば幸いです。

投稿2019/01/16 00:17

編集2019/01/21 04:19

jawa

総合スコア3013

teruo

2019/01/16 09:38

ありがとうございました。明日、試してみます。

teruo

2019/01/17 14:25

回答ありがとうございました。２つとも、難しくて手が出ません。素人には難しいです。

jawa

2019/01/21 04:27 編集

ひとつめに紹介した記事は「エラーの回避策としてSendInputが使えるよ」ということを説明しているので少し難しいですね。ふたつめに紹介した記事では、質問者さんと似たような状況でお困りの方に対して「SendInputはこう使うんだよ」というサンプルコード付きで回答してくれている親切な方がいます。こちらが理解できないようなら、少し勉強が足りない…というと厳しい表現になりますが、技術者として今回発生している問題を解決したいのなら「これを理解できるように努力する」必要があるように思います。 --- とはいえ、理解が難しかったということでしたので、・「paintを操作する」という方針でのエラー回避策（SendInputの利用方法）・「セル範囲を図としてコピペする」という観点から、別手段での対応案を回答本文に追記をさせていただきました。 (すでに解決済みではありますが、後続の方のためでもありますので追記させていただきました) 少し長くなってしまいましたが、わかり難い点等があればご質問ください。参考になれば幸いです。

行動規範の内容に同意します

ペイントを起動し、セル範囲を貼り付けするまでを記載してみました。
かなり難しいことに挑戦されていると思われますので、まずはVBAに関する基礎知識を習得することをお勧めします。

VBA
1Sub MsPaint()
2    Dim StartSec As Single
3    Worksheets("データ収集").Activate
4    'セル範囲をコピー
5    Worksheets("データ収集").Range("B51:L55").Copy
6    'ペイントを起動
7    Shell "mspaint.exe", vbNormalNoFocus
8    With CreateObject("Wscript.Shell")
9        'ペイントがアクティブになるのを待つ
10        Do Until .AppActivate("無題 - ペイント")
11            DoEvents
12        Loop
13        '１秒待つ
14        StartSec = Timer
15        Do Until Timer - StartSec >= 1
16            DoEvents
17        Loop
18        '貼り付け
19        .SendKeys "^v", True
20    End With
21    'Excelに戻る
22    VBA.AppActivate Application.Caption
23End Sub