Excel VBA質問箱 IV

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

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


1883 / 13645 ツリー ←次へ | 前へ→

【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 発言[未読]

【71252】画像貼付
質問  ET  - 12/2/15(水) 13:22 -

引用なし
パスワード
   画像貼付ブックと画像印刷ブックがあります。

画像貼付xlsmの画像貼付シートのセル"F4","F7","F10"にマクロボタンを押すと画像を選択して、画像をセルいっぱいに貼り付け、

画像印刷xlsmの画像印刷シートのセル"B3","AJ3","BR3"にリンクされた図をセルいっぱいに貼り付けることは可能でしょうか?

尚、画像貼付xlsmに貼り付ける画像は、図の挿入の場合と挿入とリンクの場合の2通りをお願い致します。

また、画像貼付ブックと画像印刷ブックを1つのブックにした画像貼付印刷xlsmの場合もお願い致します。

下記にアップしましたので参照下さいませ。

ux.getuploader.com/Excel2010/download/1/%E7%94%BB%E5%83%8F%E8%B2%BC%E4%BB%98%E5%8D%B0%E5%88%B7.zip

ダウンPass:excel
解凍Pass:excel

以上、わかりにくい質問ですが宜しくお願い致します。

【71253】Re:画像貼付
発言  UO3  - 12/2/15(水) 13:40 -

引用なし
パスワード
   ▼ET さん:

回答ではなく、また、参考情報としてアップされたURLも見ていませんが。
これと同じようなテーマで、ここ数日、様々な掲示板に様々な人から質問がアップされています。
それぞれが別の人のようですし、マルチポストではないと思うのですが
何か、学校の課題で、このようなテーマを与えられているということでしょうか?

【71254】Re:画像貼付
回答  ET  - 12/2/15(水) 14:03 -

引用なし
パスワード
   ▼UO3 さん:

別人ですし、学生でもありません。
宜しくお願い致します。

【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

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