Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

8580 / 76807

←次へ　｜　前へ→


	【73797】写真挿入のVBA

wen - 13/2/15(金) 23:03 -


	引用なし

	パスワード

エクセルで写真集を作るためのVBAですが、以下のVBAでは画像がリンク貼り付けになってしまいます。どうしたらエクセルファイルに画像を貼りこみで保存できるのでしょうか？
よろしくお願いいたします。

やりたいことは、まずダブルクリックでダイアログボックスを表示させ、挿入したい写真を選択、写真がセルに合わせた大きさに縮小、セルの中央に写真を配置。以上です。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
　　　　　　　　　　　　　　　　　　　　Cancel As Boolean)
　　Dim PicFile As Variant
　　Dim rX As Double, rY As Double

　　'［ファイルを開く］ダイアログボックスを表示
　　PicFile = Application.GetOpenFilename( _
　　　　　　　　　　　　"画像ファイル,*.jpg;*.jpeg;*.gif;*.tif;*.png;*.bmp")
　　If VarType(PicFile) = vbBoolean Then Cancel = True: Exit Sub

　　Application.ScreenUpdating = False
　　
　　'画像を挿入
　　With ActiveSheet.Pictures.Insert(PicFile)
　　　　rX = Target.Width / .Width
　　　　rY = Target.Height / .Height
　　　　If rX > rY Then
　　　　　　.Height = .Height * rY
　　　　Else
　　　　　　.Width = .Width * rX
　　　　End If

　　　　'セルの中央（横方向/縦方向の中央）に配置
　　　　.Left = Target.Left + (Target.Width - .Width) / 2
　　　　.Top = Target.Top + (Target.Height - .Height) / 2
　　End With
　　
　　Application.ScreenUpdating = True
　　Cancel = True
End Sub

2 hits

▼

【73797】写真挿入のVBA wen 13/2/15(金) 23:03

≪