Excel VBA質問箱 IV

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

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


11021 / 76734 ←次へ | 前へ→

【71255】Re:画像貼付
発言  kanabun  - 12/2/15(水) 14:35 -

引用なし
パスワード
   ▼ET さん:
要件そのものではありませんが、以下は セル F4,F7,F10 のどれかが
ダブルクリックされたら、図の貼り付け、
右クリックされたら、図のリンク貼り付け
をするサンプルコードです。
コードは対象シートの シートモジュールに記述して使います。

参考まで:
各Eventプロシージャの中身を 各「ボタン」に移動またはCopyすれば,
ボタンのClickで同じ処理が可能となります。

'---------------------------------- Sheet モジュール
Option Explicit

'// 画像貼り付け
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Dim picName
 Dim c As Range
  Set c = Intersect(Target, Range("F4,F7,F10"))
  If c Is Nothing Then Exit Sub
  Cancel = True
  picName = Application.GetOpenFilename("画像,*.jpg;*.jpeg;*.gif", , "画像選択")
  If VarType(picName) = vbBoolean Then Exit Sub
   
  Me.Shapes.AddPicture picName, _
      LinkToFile:=msoFalse, _
      SaveWithDocument:=msoTrue, _
      Left:=c.Left, Top:=c.Top, _
      Width:=c.Width, Height:=c.Height
     
End Sub

'// 図のリンク貼り付け
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 Dim picName
 Dim c As Range
  Set c = Intersect(Target, Range("F4,F7,F10"))
  If c Is Nothing Then Exit Sub
  Cancel = True
  picName = Application.GetOpenFilename("画像,*.jpg;*.jpeg;*.gif", , "画像選択")
  If VarType(picName) = vbBoolean Then Exit Sub
   
  Me.Shapes.AddPicture picName, _
      LinkToFile:=msoTrue, _
      SaveWithDocument:=msoFalse, _
      Left:=c.Left, Top:=c.Top, _
      Width:=c.Width, Height:=c.Height

End Sub

4 hits

【71252】画像貼付 ET 12/2/15(水) 13:22 質問
【71253】Re:画像貼付 UO3 12/2/15(水) 13:40 発言
【71254】Re:画像貼付 ET 12/2/15(水) 14:03 回答
【71255】Re:画像貼付 kanabun 12/2/15(水) 14:35 発言

11021 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free