Excel VBA質問箱 IV

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

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


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

8562 / 13655 ﾂﾘｰ

←次へ　｜　前へ→

▼

【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さま、レスありがとうございました。

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

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

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


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

8562 / 13655 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free