【エクセルマクロ】ユーザーフォームの画像をコピー？

質問

ユーザーフォームにある画像を、
クリックしたら、クリップボードにコピーするにはどうしたらいいですか？

コピーのメソッドはないようで、
下記はエラーになります。

Private Sub Image1_Click()
Me.Image1.Picture.Copy
End Sub

回答No.3

real beatin（@realbeatin） · ベストアンサー

No.1お礼欄への返信です。

> アウトルックに貼り付けて ... メール送信ということをしたいのです
> ... 一番早いのはクリップボードかなあ、と ...

HTML形式のメールであれば、画質はともかく、No.1の方法からでも図としての貼付けは出来ますね。

添付ファイルとして送るとかなら、クリップボードに画像ファイルのパスを送っておけば、
メール作成画面で、[ファイルの添付]で表示される[ファイルの挿入]ダイアログにて、
そのままCtrl+Vを押せば、[ファイル名]欄に対象の画像のパスが表示されるので、
[挿入]ボタンを押すとか。
要は文字列としてのファイルパス（aryPict(i)）をコピーした状態を作るという感じ。
原本を送ることにはなりますが、メールですから原画質で送受信されるかは環境次第です。

' ' ///
' ' Image1を右クリックしたら
' ' 現在表示中の画像（aryPict(i)）のファイルパスを
' ' クリップボードに送る
Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim oDTO As New MSForms.DataObject
　' ' Image1を右クリックしたら
　　If Button = 2 Then
　　　' ' Image1に現在表示中の画像（aryPict(i)）のファイルパスをクリップボードに
　　　　With oDTO
　　　　　　.Clear
　　　　　　.SetText aryPict(i), 1
　　　　　　.PutInClipboard
　　　　End With
　　End If
End Sub

' ' ///

No.1の回答趣旨に副えば、ExcelからOutlook VBAを操作する、
ということになりますが、複数の写真を貼ることもあるのでしょうし、
セキュリティ的な面からみても、メール作成は手作業の方が
自分で作成内容が解って良いかもですね。
VBAで操作出来なくもないですけれど、
殆どの作業が自分好みのメール作成の仕方みたいな感じなので、
こちらからレクチャーするものでもないのかな、と。
Outlook VBAは長いこと触っていない私だったりもしますが、それは置いても、
このケースはクリップボードの方が扱い易くて安心なのだと思います。

話を整理しますと、
HTML形式のメールに図として貼付ける場合は、今質問への回答No.1の２つ目のやり方で、
添付ファイルとして送る場合は、この回答に書いたやり方で、
ということになります。

念の為ですが、前回の回答No.1で
>> ※　一応、LoadPictureした後は、Me.Repaint、した方が無難かと。
と書いていましたが、クリップボードを扱う関係で必須になります。
　　Me.Image1.Picture = LoadPicture(aryPict(i))
の次の行に
　　Me.Repaint
をお忘れなく。
それから、今質問への回答No.1のように画像（図）をコピーした場合は、
クリップボードに連続してコピー→貼付けすることが出来るのですが、
クリップボード画面にすべての画像のプレビューが表示されないかも知れませんが、
（プレビューはありません）と表示されていれば、貼付けは出来ますので。

以上になります。

お礼

ありがとうございます！
選択範囲をメールに貼り付け送るというマクロも
書いて試してみたのですが、
実際運営していると
一枚や二枚になったり、送り先がそのつど変わったりとするので
手動で送るほうが便利かなあと思ってます。
本当に助かりました。ありがとうございます！！！！

回答No.4

real beatin（@realbeatin）

一応、やり方が選べるように、例として、
　Image1 を 右Click して写真を（複数）選択しておいて、
　CommandButton3 を Click すると、
　Outlook の メール作成画面が開いて、
　選択していた写真を添付ファイルに自動指定する
　（その他諸々）
のコードを参考までに挙げておきます。
例えばセキュリティの問題でOutlook側で受け付けて貰えない可能性もありますし、
何れにしてもお好みの形にカスタマイズする必要はあるでしょうけれど、
取っ掛かり、ぐらいにはなるのかなぁ？と。
参考ページ。
三流君VBA > Outlookでファイルを添付するには？.Attachments.Add
http://www.ken3.org/vba/backno/vba078.html

' ' UserFormモジュール先頭、宣言部
Dim colAttPict As Collection　'　選択した写真のパスを格納するコレクションオブジェクト

Private Sub CommandButton3_Click()
Const olMailItem = 0
Dim olApp As Object　'　Outlookアプリケーション
Dim v
　　If colAttPict Is Nothing Then MsgBox "写真未選択": Exit Sub
　　Set olApp = CreateObject("Outlook.Application")　'　Outlookアプリケーションオブジェクトの生成
　　With olApp.CreateItem(olMailItem)　'　メールオブジェクト
　　　　For Each v In colAttPict　'　選択した写真のパスをコレクションオブジェクトで総当たり
　　　　　　.Attachments.Add v　'　選択した写真のパスをメールの添付ファイルに指定
　　　　Next
　　　　Set colAttPict = Nothing　'　コレクションオブジェクト解放
　　　　.To = "xxxx@xxx.co.jp"　'　メール宛先
　　　　.CC = "yyyy@xxx.co.jp"　'　〃
　　　　.Subject = "画像添付テスト"　'　メールタイトル
　　　　' ' メール本文
　　　　.Body = "こんにちは" & vbCrLf _
　　　　　　　　& "画像添付のテストです。" & vbCrLf _
　　　　　　　　& "如何でしょう？"
　　　　olApp.GetNameSpace("MAPI").GetDefaultFolder(6).Display　'　Outlookアプリケーション表示
　　　　.Display　'　メール編集画面の表示
　　End With
　　Set olApp = Nothing
End Sub

Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
　　If Button = 2 Then　'　Image1を右クリックしたら
　　　　If colAttPict Is Nothing Then Set colAttPict = New Collection　'　コレクションオブジェクトが未生成なら生成
　　　　colAttPict.Add aryPict(i), CStr(i)　'　選択した写真のパスをコレクションオブジェクトに追加
　　End If
End Sub

回答No.2

real beatin（@realbeatin）

回答No.1です。
失礼しました。編集漏れがありまして、
>　　If Button = fmButtonRight Then　
fmButtonRight はTypeが未定義のまま掲載していますので、
１つめのコードはエラーになります。
２つめのコードに合わせて、
　　If Button = 2 Then
に差し替えてください。

尚、こちらからの例示は、
> Image1を右クリックしたらば
というものですが、
　左クリックなら
　　If Button = 1 Then
　右クリックなら
　　If Button = 2 Then
　中（ホイールボタン等）クリックなら
　　If Button = 4 Then
という風に、お求めの仕様に合わせて替えてください、
という主旨で書いていたものです。

以上、訂正でした。

回答No.1

real beatin（@realbeatin）

こんにちは。
【エクセルマクロVBA】写真のスライドショーしたい
http://okwave.jp/qa/q9163937.html
でも回答しました。

> ユーザーフォームにある画像を、
> クリックしたら、クリップボードにコピーするにはどうしたらいいですか？

　コピー
　貼付け
２工程分ける必要があるかどうかまずは確認が必要ですね。
画質の劣化を防ぐ意味でも、コピーではなくて、
直接画像ソースを取り込む方が有利な気がします。
問題は貼付け先ですね。
ＶＢＡで送れる相手なら直接画像を読み込ませて表示させればいいのでしょうし、
クリップボードを経由することが本当に必要なのか、ということで
設計は変わってくるのだと思います。
さしあたり、前回のNo.1お礼欄のコードが原型を留めているのでしたら、
大元の画像ファイルのパスが取得済ですから、
ワークシートに対してはあっさりと処理できます。

' ' ///
' ' Image1を右クリックしたらば、
' ' 現在表示中の画像をアクティブシート（アクティブセルを左上にして）に挿入する

Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
　' ' Image1を右クリックしたら[fmButtonLeft | fmButtonRight | fmButtonMiddle]
　　If Button = fmButtonRight Then　
　　　' ' Image1に現在表示中の画像（aryPict(i)）をアクティブセルに挿入する
　　　　ActiveSheet.Pictures.Insert aryPict(i)
　　End If
End Sub

' ' ///

> クリップボードにコピーする
という目的で考えても、
上記の簡単なマクロで一旦シート上に挿入したものを切り取る、
という手順が簡単でいいかなぁと。

' ' ///　簡易版
' ' Image1を右クリックしたらば、
' ' 現在表示中の画像をアクティブシート（アクティブセルを左上にして）に挿入し
' ' 挿入した画像を切り取って、クリップボードに送る

Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
　' ' Image1を右クリックしたら[1 = fmButtonLeft | 2 = fmButtonRight | 4 = fmButtonMiddle]
　　If Button = 2 Then
　　　' ' Image1に現在表示中の画像（aryPict(i)）をアクティブセルに挿入し切り取る
　　　　ActiveSheet.Pictures.Insert(aryPict(i)).Cut
　　End If
End Sub

' ' ///

シートに画像は残りませんし、そのまま外部アプリケーションに貼り付けも可能です。
難を云えば、
アクティブシートが[シートの保護]を適用している場合のケアとか、
保存済のブックが未保存になるとか、
まぁ必要なら対応は簡単に出来るでしょうけれど。
後は貼り付け先で要求される画質ですね。
エクセルシートで読み込む方法も数通りありますが、
[図の挿入]レベルで良ければ問題になりませんし、
元の写真の画質を忠実に再現するのならば、やはり、
コピーせずに、直接読み込ませる方が合理的かと。

ご要望に適わない点がありましたら
「コピーした後どうしたいのか」について補足をお願いします。

お礼

ありがとうございます！！！！

おかげさまで、前回助けて頂いたスライドショーがとても役立っています。
毎日大体100の写真がアップされ、写真の名前によって分けて表示するコードを追加しました。それでまあ２０枚から２５枚、一個つづ見てくんですが、気になる写真、例えばチームメンバーに「はあ、これ、どうなってるのよ！！！？？」と聞かなきゃいけない写真が１枚か２枚出てきます。それを右クリックで、アウトルックに貼り付けてチームメンバーにメール送信ということをしたいのです・・・だから、一番早いのはクリップボードかなあ、と思い質問しました。アドバイスを頂けましたら幸いです。