Excel VBA質問箱 IV

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

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


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

3361 / 76735

←次へ　｜　前へ→


	【79005】エクセルへの写真画像の貼り付け

ひでとし

- 17/4/10(月) 21:34 -


	引用なし

	パスワード

エクセルのセルでダブルクリックすると、画像を選び、セルにぴったり収まるように一番大きく貼り付けます。デジカメで撮った画像は、ぴったりに収まりません。やや小さくなります。オリジナル画像をペイントで呼び出してそのまま上書き保存をすると、今度はその画像はぴったり収まります。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.Height / Target.Width
　　　　rY = .Height / .Width
　　　　If rX > rY Then
　　　　　　　 .Width = Target.Width
　　　　Else
　　　　　　　.Height = Target.Height
　　　　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

1 hits

▼

【79005】エクセルへの写真画像の貼り付け ひでとし 17/4/10(月) 21:34