Excel VBA質問箱 IV

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

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


37045 / 76732 ←次へ | 前へ→

【44861】Re:写真貼り付け
回答  Kein  - 06/12/4(月) 13:28 -

引用なし
パスワード
   右クリックイベントを使う方法です。
以下のコードをシートモジュールに入れ、任意の2つ以上のセル範囲を
選択し、右クリックして下さい。すでに画像を挿入している範囲に重なると、
メッセージで警告して処理を中止します。画像が挿入されてない範囲であれば、
画像ファイルを保存しているフォルダーから、ファイルを選択して開くための
ダイアログが出ますから、選択してOKして下さい。初めに選択したセル範囲に
ぴったり収まる位置・大きさで挿入することが出来ます。


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)
  Dim Lp As Single, Tp As Single
  Dim Hp As Single, Wp As Single
  Dim i As Long
  Dim MyF As String
  Const PicFol As String = _
  "C:\Documents and Settings\User\My Documents\My Pictures"
  '↑実際に画像ファイルを保存しているフォルダーのパスに変更しておく。
 
  Cancel = True
  With Target
   If .Count = 1 Then Exit Sub
   Lp = .Left: Tp = .Top
   Wp = .Width: Hp = .Height
  End With
  With ActiveSheet.Pictures
   If .Count > 0 Then
     For i = 1 To .Count
      If Not Intersect(Target, _
      Range(.Item(i).TopLeftCell, .Item(i).BottomRightCell)) _
       Is Nothing Then
        MsgBox "そのセル範囲には画像を挿入できません", 48: Exit Sub
      End If
     Next
   End If
   ChDir PicFol
   MyF = Application.GetOpenFilename("画像ファイル(*.jpg),*.jpg")
   If MyF = "False" Then GoTo ELine
   Application.ScreenUpdating = False
   With .Insert(MyF)
     .Left = Lp: .Top = Tp
     .Width = Wp: .Height = Hp
   End With
  End With
ELine:
  With Application
   ChDir .DefaultFilePath
   .ScreenUpdating = True
  End With
End Sub
1 hits

【44855】写真貼り付け やっぱり猫が好き 06/12/4(月) 9:02 質問
【44857】Re:写真貼り付け ハチ 06/12/4(月) 10:44 回答
【44860】Re:写真貼り付け やっぱり猫が好き 06/12/4(月) 12:33 お礼
【45073】Re:写真貼り付け やっぱり猫が好き 06/12/12(火) 9:51 お礼
【44861】Re:写真貼り付け Kein 06/12/4(月) 13:28 回答
【45074】Re:写真貼り付け やっぱり猫が好き 06/12/12(火) 9:56 お礼

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