Excel VBA質問箱 IV

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

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


268 / 73642 ←次へ | 前へ→

【79005】エクセルへの写真画像の貼り付け
質問  ひでとし E-MAIL  - 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

72 hits

【79005】エクセルへの写真画像の貼り付け ひでとし 17/4/10(月) 21:34 質問[未読]
【79016】Re:エクセルへの写真画像の貼り付け ひでとし 17/4/14(金) 20:43 発言[未読]
【79018】Re:エクセルへの写真画像の貼り付け β 17/4/14(金) 20:57 発言[未読]
【79019】Re:エクセルへの写真画像の貼り付け γ 17/4/14(金) 23:18 発言[未読]
【79020】Re:エクセルへの写真画像の貼り付け ひでとし 17/4/15(土) 3:43 質問[未読]
【79021】Re:エクセルへの写真画像の貼り付け β 17/4/15(土) 8:55 発言[未読]
【79022】Re:エクセルへの写真画像の貼り付け ひでとし 17/4/15(土) 9:58 回答[未読]

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