Excel VBA質問箱 IV

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

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


8551 / 13644 ツリー ←次へ | 前へ→

【31027】Wクリックで画像を挿入するには よしお 05/11/9(水) 14:49 質問[未読]
【31030】Re:Wクリックで画像を挿入するには MARBIN 05/11/9(水) 15:23 回答[未読]
【31032】Re:Wクリックで画像を挿入するには Kein 05/11/9(水) 15:42 回答[未読]
【31034】Re:Wクリックで画像を挿入するには よしお 05/11/9(水) 16:19 質問[未読]
【31035】Re:Wクリックで画像を挿入するには Kein 05/11/9(水) 16:34 発言[未読]
【31039】Re:Wクリックで画像を挿入するには よしお 05/11/9(水) 19:21 お礼[未読]
【32599】Re:Wクリックで画像を挿入するには 再投稿 よしお 05/12/19(月) 9:05 質問[未読]
【32603】Re:Wクリックで画像を挿入するには 再投稿 Kein 05/12/19(月) 12:05 回答[未読]
【32604】Re:Wクリックで画像を挿入するには 再投稿 Kein 05/12/19(月) 12:07 発言[未読]
【32612】Re:Wクリックで画像を挿入するには 再投稿 よしお 05/12/19(月) 16:27 質問[未読]
【32614】Re:Wクリックで画像を挿入するには 再投稿 Kein 05/12/19(月) 16:46 回答[未読]
【32616】Re:Wクリックで画像を挿入するには 再投稿 よしお 05/12/19(月) 17:22 お礼[未読]

【31027】Wクリックで画像を挿入するには
質問  よしお  - 05/11/9(水) 14:49 -

引用なし
パスワード
   はじめまして、よろしくお願い申し上げます。

結合したセルの大きさに合わせて画像を挿入するマクロを
使っているのですが、例えば画像を挿入したいセルをWクリックする事に
よって同様の操作をする方法はありますでしょうか?

現在の記述は以下の通りです。

Sub 画像貼付け()
   
  Dim Fname As String
  Dim mySh As Shape

  Fname = Application.GetOpenFilename _
    (filefilter:="JPEG形式(*.jpg), *.jpg", _
    Title:="画像を選択して下さい")

  If Fname = "False" Then Exit Sub

  With ActiveSheet
    Set mySh = .Shapes.AddPicture(Filename:=Fname, _
      linktofile:=True, savewithdocument:=False, _
      Left:=Selection.Left, Top:=Selection.Top, _
      Width:=Selection.Width, _
      Height:=Selection.Height)
  End With

  ChDir ThisWorkbook.Path
   
End Sub

【31030】Re:Wクリックで画像を挿入するには
回答  MARBIN  - 05/11/9(水) 15:23 -

引用なし
パスワード
   Worksheet_BeforeDoubleClickを使います。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

  Dim Fname As String
  Dim mySh As Shape
  
  Cancel = True

  Fname = Application.GetOpenFilename _
    (filefilter:="JPEG形式(*.jpg), *.jpg", _
    Title:="画像を選択して下さい")

  If Fname = "False" Then Exit Sub

  With ActiveSheet
    Set mySh = .Shapes.AddPicture(Filename:=Fname, _
      linktofile:=True, savewithdocument:=False, _
      Left:=Selection.Left, Top:=Selection.Top, _
      Width:=Selection.Width, _
      Height:=Selection.Height)
  End With

'  ChDir ThisWorkbook.Path
  
End Sub

【31032】Re:Wクリックで画像を挿入するには
回答  Kein  - 05/11/9(水) 15:42 -

引用なし
パスワード
   シートモジュールに

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
  Dim Lp As Single, Tp As Single
  Dim Wp As Single, Hp As Single
  Dim fName As String
  Const Ph As String = _
  "C:\Documents and Settings\User\My Documents\My Pictures"
  '↑実際に画像ファイルを保存しているフォルダーのバスに変更
 
  With Target
   Lp = .Left: Tp = .Top
   Wp = .Height: Hp = .Height
  End With
  ChDir Ph
  With Application
    fName = .GetOpenFilename("画像ファイル(*.jpg), *.jpg", _
    Title:="画像を選択して下さい")
    If fName = "False" Then GoTo ELine
    .ScreenUpdating = False
  End With
  Cancel = True
  With ActiveSheet.Pictures.Insert(fName)
   .Left = Lp: .Top = Tp
   .Width = Wp: .Height = Hp
   .OnAction = "Del_Pic"
  End With
ELine:
  With Application
   ChDir .DefaultFilePath
   .ScreenUpdating = True
  End With
End Sub

標準モジュールに

Sub Del_Pic()
  Dim x As Variant
 
  x = Application.Caller
  If VarType(x) <> 8 Then Exit Sub
  If MsgBox("この画像を削除しますか", 36) = 6 Then
   ActiveSheet.Pictures(x).Delete
  End If
End Sub

を入れて、任意のセルをダブルクリックして下さい。
挿入した画像は、クリックすると削除するかどうかを選ぶ MsgBox が出るように
しておきました。

【31034】Re:Wクリックで画像を挿入するには
質問  よしお  - 05/11/9(水) 16:19 -

引用なし
パスワード
   MARBINさん Keinさん レスありがとうございました。

早速、実行してみましたところ、MARBINさんにアドバイス頂きましたものは
正しく動作いたしました。

Keinさんの記述に関しましては、せっかく教えて頂いたのに申し訳ありませんが、
長方形のセルに対して、挿入画像が正方形になってしまいます。
当方の環境にも原因があるかも知れませんので、先ずはどこを見直せば
よろしいでしょうか?

【31035】Re:Wクリックで画像を挿入するには
発言  Kein  - 05/11/9(水) 16:34 -

引用なし
パスワード
   あー・・すいません。横幅の取得のところで、高さを取得してしまってました。

With Target
  Lp = .Left: Tp = .Top
  Wp = .Width: Hp = .Height
End With

と、変更してみて下さい。

【31039】Re:Wクリックで画像を挿入するには
お礼  よしお  - 05/11/9(水) 19:21 -

引用なし
パスワード
   Keinさん、レスありがとうございました。

変更しましたところ、一切の問題なく動作いたしました。

MARBINさん Keinさん
この度、アドバイス頂きました事は、用途に応じて使い分けていこうと思います。 

お手数をかけて申し訳ありませんでした。

ありがとうございました。

【32599】Re:Wクリックで画像を挿入するには 再投稿
質問  よしお  - 05/12/19(月) 9:05 -

引用なし
パスワード
   こんにちは。
以前にこちらでアドバイスを頂きましたよしおと申します。

以来、快適に作業していたのですが、
画像を挿入したxlsファイルをメールに添付した場合、
受信者の側では全ての画像が表示されていない事が分かりました。

おそらく、こちらのローカルでの画像ファイルパスを参照している事が
原因かと推測しているのですが、
改善策はありますでしょうか?

現在の記述は以下の通りです。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

  Dim Fname As String
  Dim mySh As Shape
 
  Cancel = True

  Fname = Application.GetOpenFilename _
    (filefilter:="JPEG形式(*.jpg), *.jpg", _
    Title:="画像を選択して下さい")

  If Fname = "False" Then Exit Sub

  With ActiveSheet
    Set mySh = .Shapes.AddPicture(Filename:=Fname, _
      linktofile:=True, savewithdocument:=False, _
      Left:=Selection.Left, Top:=Selection.Top, _
      Width:=Selection.Width, _
      Height:=Selection.Height)
  End With

'  ChDir ThisWorkbook.Path
 
End Sub

よろしくお願い申し上げます。

【32603】Re:Wクリックで画像を挿入するには 再投稿
回答  Kein  - 05/12/19(月) 12:05 -

引用なし
パスワード
   そのコードは、GetOpenFilename を使って「画像の保存先フォルダーから任意の
ファイルを選んで、マクロを実行しているブックへ挿入する」という形になっています。
従って
>画像を挿入したxlsファイルをメールに添付
というのは適切ではありません。そのような場合、送信先のPCには当然 Excel が
インストールされているという前提になるのだから、マクロをエクスポートした
コードのみのファイル(拡張子が bas とか cls になっている)と共に、画像ファイル
(bmp や jpgなど)を添付して送ります。そしてメール本文に、マクロファイルは
ExcelのVBEでインポートし、画像ファイルは「通常エクセルを開いているフォルダー」
へ保存してもらうよう、説明を付けておきます。
それらのことが出来るなら、のコードを

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
  Dim Fname As String
   
  Cancel = True
  With Application
    ChDir .DefaultFilePath
    Fname = .GetOpenFilename("JPEG形式(*.jpg), *.jpg", , _
   "画像を選択して下さい")
  End With
  If Fname = "False" Then Exit Sub
  With Target
    ActiveSheet.Shapes.AddPicture(Filename:=Fname, _
    Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
  End With
End Sub

というように修正してから、エクスポートすれば良いでしょう。

【32604】Re:Wクリックで画像を挿入するには 再投稿
発言  Kein  - 05/12/19(月) 12:07 -

引用なし
パスワード
   >「通常エクセルを開いているフォルダー」

「通常、エクセル・ブックを開いているフォルダー」

です。

【32612】Re:Wクリックで画像を挿入するには 再投稿
質問  よしお  - 05/12/19(月) 16:27 -

引用なし
パスワード
   Keinさま
前回に続き、この度もレス頂きましてありがとう御座いました。

やはり事前に受信者との申合わせが必要になってしまいますね。

そこで、手探りながらですが以下の様に記述してみました。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Dim WDT, HGT, CTP, CLF, PWD, PHT, FName
 
 Cancel = True
 
 WDT = Selection.Width
 HGT = Selection.Height
 CTP = Selection.Top
 CLF = Selection.Left
 FName = Application.GetOpenFilename
 ActiveSheet.Pictures.Insert(FName).Select
  Selection.ShapeRange.LockAspectRatio = msoTrue
  PWD = Selection.ShapeRange.Width
  PHT = Selection.ShapeRange.Height
 Select Case PHT / PWD
  Case Is >= HGT / WDT
   Selection.ShapeRange.Height = HGT
   Selection.ShapeRange.Left = CLF + (WDT - Selection.ShapeRange.Width) / 2
  Case Else
   Selection.ShapeRange.Width = WDT
   Selection.ShapeRange.Top = CTP + (HGT - Selection.ShapeRange.Height) / 2
 End Select
   
End Sub


これですと挿入した画像も送信できるみたいです。
しかし、セルをWクリック後に表示される画像選択のダイアログボックスで
「キャンセル」ボタンをクリックすると以下のエラーが発生します。

実行時エラー'1004':
PicturesクラスのInsertプロパティを取得できません。

画像を選択して「開く」ボタンをクリックした時にはエラーは
表示されず、画像は正しく挿入できています。

この場合、どの部分の見直しが必要でしょうか?

【32614】Re:Wクリックで画像を挿入するには 再投稿
回答  Kein  - 05/12/19(月) 16:46 -

引用なし
パスワード
   >FName = Application.GetOpenFilename
の直後に

If FName = "False" Then Exit Sub

が無いからです。ま、この書き方には何とおりかあって
>Dim WDT, HGT, CTP, CLF, PWD, PHT, FName
というように全部 Variant型で宣言しているなら

If TypeName(FName) = "Boolean" Then Exit Sub

とか

If VarType(FName) = 11 Then Exit Sub

などでも結構です。要は、キャンセルを押したときの"定石"とも言うべきコードが
抜けているからエラーになる、ということです。

【32616】Re:Wクリックで画像を挿入するには 再投稿
お礼  よしお  - 05/12/19(月) 17:22 -

引用なし
パスワード
   Keinさま、レスありがとうございました。

無事に解決しましたので御報告申し上げます。

>キャンセルを押したときの"定石"
全くおっしゃる通りです。

この度も多くのアドバイスありがとうございました。

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