• 締切済み

エクセル貼付けの画像がメール添付で表示されません

下記のようなVBA（ネット公開されているものを利用させていただいています）を使用し、エクセルに画像を貼り付けています。 画像を貼り付けたエクセルを保存後、メールに添付すると貼り付けた画像が表示されなくなります。 ファイルの容量も少なく、エクセルに取り込んだ画像は、リンク貼り付けになっているのかと考えていますが、取り込んだ画像を埋め込むにはどのようにすればいいでしょうか。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ Cancel As Boolean) Dim myPic Dim myRange As Range '画像を配置するセル範囲 Dim rX As Double, rY As Double myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") If VarType(myPic) = vbBoolean Then Exit Sub Set myRange = Target 'このセル範囲に収まるように画像を縮小する Application.ScreenUpdating = False With ActiveSheet.Pictures.Insert(myPic).ShapeRange rX = myRange.Width / .Width rY = myRange.Height / .Height If rX > rY Then .Height = .Height * rY Else .Width = .Width * rX End If .Left = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置 .Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置 End With Application.ScreenUpdating = True Cancel = True End Sub

  • verify
  • お礼率44% (384/858)

みんなの回答

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

下記のような記事がある。 https://support.microsoft.com/ja-jp/topic/excel-2010-%E3%81%A7-pictures-insert-%E3%83%A1%E3%82%BD%E3%83%83%E3%83%89%E3%82%92%E4%BD%BF%E7%94%A8%E3%81%97%E3%81%A6%E5%9B%B3%E3%82%92%E3%83%AF%E3%83%BC%E3%82%AF%E3%82%B7%E3%83%BC%E3%83%88%E3%81%AB%E6%8C%BF%E5%85%A5%E3%81%99%E3%82%8B%E3%81%A8%E5%9B%B3%E3%81%8C%E3%83%AA%E3%83%B3%E3%82%AF-%E3%82%AA%E3%83%96%E3%82%B8%E3%82%A7%E3%82%AF%E3%83%88%E3%81%A8%E3%81%97%E3%81%A6%E6%8C%BF%E5%85%A5%E3%81%95%E3%82%8C%E3%82%8B-c8f364ea-bcc1-1397-5df7-a1b4c5fbab78 Excel 2010 で Pictures.Insert メソッドを使用して図をワークシートに挿入すると図がリンク オブジェクトとして挿入される 回避策も載っている。 ＝＝＝＝ ややこしいことですな。 画像ファイルが、その（メイル受信者の）世界にあるか（来ているか）、アクセスして利用する場合は、アクセスできるか、常に考えないといけない。送信者のLocalなDiskにあるだけではだめ。業者のサーバーに上げたものは、他人にアクセル出来るが、それ以外はアクセスできるものかどうか、考えないといけない。その写真ファイルが、受信者のLocalなDiskに持ってこっれるかどうか。 ＝＝ OutlookのVBAもあるので、そちらでやるのを考えてはどうかな。 https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q11213886746 VBAでメールの本文に画像を表示する方法を知りたいです という記事もある。

回答No.1

下記ページは参考になりませんか？ > 画像や図をリンクオブジェクトとしてではなく、実体ファイルとして挿入するには、 > Pictures.Insert メソッドではなく、Shapes.Add メソッドを使用します。 エクセルのマクロで図や画像をリンクではなく実体で貼り付け挿入する方法 https://boukenki.info/excel-macro-zu-gazou-sounyu-houhou/

verify
質問者

補足

ありがとうございました。 質問の意図が伝わりにくいかったのかもしれません。このVBAを使用して結構な数のファイルを作成してしまい、それらのファイルのリンクで貼り付けられている画像の再埋め込むことができないかというのがメインの趣旨になります。ご存知であればお願いします。 これから作成するファイルに関しては、お教えいただいたShapes.Add メソッドを使ってみたいと思います。ありがとうございました。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. Excel（エクセル）

関連するQ&A

  • Excelセルのサイズに合わせて画像を表示させたい

    Excelのセルの中に、画像ファイル(撮影された写真)のサイズを挿入するときに、セルのサイズに合わせて画像を表示させたいと考え、インターネット上でVBの下記のマクロを探してみました。 　セルをダブルクリックすると、画像ファイルの読み出しが行なわれるのですが、セルのサイズにピッタリと合わず、 「列」にわずかに隙間が空いてしまいます・・・。 　セルのサイズに合わせる為にはどうすればよいでしょうか？ 　もう一つ質問させていただきたいのですが、一部の画像は読み出しだ際に、縦にして自動的に表示させたいです。 (これまではExcelの「図の書式設定」で-90度と手入力していました) 　何卒宜しくお願い致します。 　 　Excel2003 　Visual Basic 6.5 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ Cancel As Boolean) Dim myPic Dim myRange As Range '画像を配置するセル範囲 Dim rX As Double, rY As Double myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") If VarType(myPic) = vbBoolean Then Exit Sub Set myRange = Target 'このセル範囲に収まるように画像を縮小する Application.ScreenUpdating = False With ActiveSheet.Pictures.Insert(myPic).ShapeRange rX = myRange.Width / .Width rY = myRange.Height / .Height If rX > rY Then .Height = .Height * rY Else .Width = .Width * rX End If .Left = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置 .Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置 End With Application.ScreenUpdating = True Cancel = True End Sub

  • エクセル　マクロ

    エクセルのある特定のセルをダブルクリックすると 画像ファイルを参照しにいき 貼りつけたい画像ファイル選ぶと そのセルの大きさに合わせて 画像ファイルがそのセルに 貼りつくというマクロが以下の通りなんですが Excel2003からExcel2007へ変更すると 画像ファイルの貼りつく位置がダブルクリックしたセルではない所に 貼りつくようになりました 参照や大きさなどはちゃんと機能しているようです どこを変更すればよいでしょうか？ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range('特定のセル)) Is Nothing Then Exit Sub Cancel = True Dim myPic Dim myRange As Range Dim rX As Double, rY As Double myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") If VarType(myPic) = vbBoolean Then Exit Sub Set myRange = Target Application.ScreenUpdating = False With ActiveSheet.Pictures.Insert(myPic).ShapeRange rX = myRange.Width / .Width rY = myRange.Height / .Height If rX > rY Then .Height = .Height * rY Else .Width = .Width * rX End If .Left = .Left + (myRange.Width - .Width) / 2 .Top = .Top + (myRange.Height - .Height) / 2 End With Application.ScreenUpdating = True Cancel = True End Sub

  • エクセルVisualBasicマクロ詳しい方

    写真を特定のセルに貼り付けるのにダブルクリックでマイドキュメントがでるようにし、 写真を貼り付けるとサイズを枠に調節するようにマクロをつくりました。 問題なく出来るようになったのですが、 ダブルクリックでマイドキュメントではなく、 別の場所を指定するにはどこをどう変えればいいですか？ 現状は以下の通りです。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Union(Range("A1:A21"))) Is Nothing Then Exit Sub Cancel = True Dim myPic Dim myRange As Range '画像を配置するセル範囲 Dim rX As Double, rY As Double myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") If VarType(myPic) = vbBoolean Then Exit Sub Set myRange = Target 'このセル範囲に収まるように画像を縮小する Application.ScreenUpdating = False With ActiveSheet.Pictures.Insert(myPic).ShapeRange rX = myRange.Width / .Width rY = myRange.Height / .Height If rX > rY Then .Height = .Height * rY Else .Width = .Width * rX End If .Left = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置 .Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置 End With Application.ScreenUpdating = True Cancel = True End Sub

  • エクセル２０１０　挿入画像の圧縮　VBA

    お世話になります。 エクセル２０１０を使用しています。写真帳を作成しダブルクリックすれば写真が挿入されるようVBAにて作成しましたが、写真の解像度が高いので挿入するたびに画像が圧縮するようにVBAを組みたいのですが、どなたかご教示ください。 具体的には一同挿入した画像を一度コピーし、再度貼り付ける・・・という動作かなと考えているのですが、マクロの記憶では記録されず・・・困っております。 現在の写真帳の構文は Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim myF As Variant Dim mySp As Object Dim myAD1 As String Dim myAD2 As String Dim myHH As Double Dim myWW As Double Dim myHH2 As Double Dim myWW2 As Double '挿入のセルを指定 If Application.Intersect(Target, Range("d6,d23,d40")) Is Nothing Then Exit Sub Cancel = True Application.ScreenUpdating = False End If '写真挿入 Next myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") If myPic = False Then MsgBox "画像を選択してください" Exit Sub End If Set myRange = Target 'このセル範囲に収まるように画像を縮小する Application.ScreenUpdating = False With ActiveSheet.Shapes.AddPicture(myPic, False, True, myRange.Left, myRange.Top, myRange.Width, myRange.Height) rX = 0.85 rY = 1 If rX > rY Then .Height = .Height * rY Else .Width = .Width * rX End If .Left = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置 .Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置 .ZOrder msoSendToBack '最背面へ移動 End With Application.ScreenUpdating = True Cancel = True End Sub 上記に.CUT　などを書き足せばよいのか・・・ →エラーばかりで動かなったので。。 　こちらに質問することにしました。 どうぞ、よろしくお願いします。

  • エクセルに写真を挿入するVBA

    エクセルで写真集を作るための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.Width / .Width 　　　　rY = Target.Height / .Height 　　　　If rX > rY Then 　　　　　　.Height = .Height * rY 　　　　Else 　　　　　　.Width = .Width * rX 　　　　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

  • エクセルでの画像貼り付け時のサイズ変換

    エクセルについて教えてください。 ペイントソフトなどで画像修正したあと、そのままコピー（クリップボードに）し、エクセルに任意の大きさで貼り付けたいのですが、そんなマクロできるでしょうか。 方法としては、自分が貼り付けたい大きさに結合したセルを選択し、貼り付け（クリップボードなので、右クリック貼り付け）をすると、そのセルの大きさに自動で縮小・拡大するような仕組みです。 いろいろな掲示板を見て、クリップボードからではなく、挿入から画像を選んで任意のセルの大きさで貼り付けるというマクロは発見できました。 それをちょっといじるとできそうな気がするんですが、なにぶん詳しくないもので、、、 だれかわかる方教えてください。 ↓挿入からセルの大きさに合わせて貼り付けるマクロ Sub haritukeru() Dim c As Range, cm As Range Application.ScreenUpdating = False For Each c In Selection Set cm = c.MergeArea If c.Address = cm.Item(1).Address Then If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub With Selection .Left = cm.Left .Top = cm.Top .Height = cm.Height .Width = cm.Width End With End If Next Set cm = Nothing Application.ScreenUpdating = True End Sub

  • エクセルのマクロで画像を貼り付け　

    画像をエクセルに貼り付ける作業を行っています。 マクロを使いファイル内の画像（約３０枚程度）を１列づつスペースを空け 右方向に４枚 １行スペースを空け ３行目の左に戻り その位置よりまた１列づつスペースを空け右方向に４枚・・・・・ これを繰り返しファイル内の画像をすべて 貼り付けたいのですがうまく動作が出来ません。 何卒ご教授の程よろしくお願いします。 ※マクロ Sub EggFunc_pasteDirImage() ' 変数定義 Dim fileName As String Dim targetCol As Integer Dim targetRow As Integer Dim targetCell As Range Dim shell, myPath Dim pos As Integer Dim extention As String Dim isImage As Boolean ' 選択セルを取得 targetCol = ActiveCell.Column targetRow = ActiveCell.Row ' フォルダ選択画面を表示 Set shell = CreateObject("Shell.Application") Set myPath = shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, "C:\Users\0602116.MS\Desktop\") Set shell = Nothing ' フォルダを選択したら... If Not myPath Is Nothing Then fileName = Dir(myPath.Items.Item.Path + "\") Do While fileName <> "" ' ファイル拡張子の判別 isImage = True pos = InStrRev(fileName, ".") If pos > 0 Then Select Case LCase(Mid(fileName, pos + 1)) Case "jpeg" Case "jpg" Case "gif" Case Else isImage = False End Select Else isImage = False End If ' 拡張子が画像であれば If isImage = True Then ' 貼り付け先を選択 Cells(targetRow, targetCol).Select Set targetCell = ActiveCell ' 画像読込み ActiveSheet.Pictures.Insert(myPath.Items.Item.Path + "\" + fileName).Select ' 画像が大きい場合、画像サイズをセル幅に合わせる If Selection.Width > targetCell.Width Or Selection.Height > targetCell.Height Then If Selection.Width / targetCell.Width > Selection.Height / targetCell.Height Then Selection.Height = Selection.Height * (targetCell.Width / Selection.Width) Selection.Width = targetCell.Width Else Selection.Width = Selection.Width * (targetCell.Height / Selection.Height) Selection.Height = targetCell.Height End If End If ' 表示位置をセル中央に移動 Selection.Top = targetCell.Top + (targetCell.Height - Selection.Height) / 2 Selection.Left = targetCell.Left + (targetCell.Width - Selection.Width) / 2 ' 貼り付け先行を+1 targetCol = targetCol + 2 End If fileName = Dir() Loop MsgBox "画像の読込みが終了しました" End If End Sub

  • Excelの写真貼り付け(90度回転)について

    xcelに写真のサイズを自動的に変更するマクロ、(セルの大きさに合わせて）を利用しています。 このマクロに対して写真を90度角度を変更して、写真を表示させたいのですが、どのようにすればよいのでしょうか？ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ Cancel As Boolean) ActiveSheet.Unprotect Dim C As Range, cm As Range Application.ScreenUpdating = False For Each C In Selection Set cm = C.MergeArea If C.Address = cm.Item(1).Address Then If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub With Selection .Left = cm.Left .Top = cm.Top .Height = cm.Height .Width = cm.Width End With End If Next Set cm = Nothing Application.ScreenUpdating = True Range("a1").Select End Sub

  • excel　マクロ　画像挿入

    以下のマクロでリンク貼り付けではない　画像挿入を作成しようと思いましたがエラーになります 詳しい方　修正　お願いいたします 当方のしたい事としましては 選択したセルでのみに画像挿入　リンクではない画像貼り付け 以下例では　B3,B17,B31,B46,B60,B74　セルをダブルクリックすればそこに画像を挿入です Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim myF As Variant Dim mySp As Object Dim myAD1 As String Dim myAD2 As String Dim myHH As Double Dim myWW As Double Dim myHH2 As Double Dim myWW2 As Double If Not Intersect(Range("B3,B17,B31,B46,B60,B74"), Target) Is Nothing Then myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif") Cancel = True '===============画像選択 myF = Application.GetOpenFilename _ ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False) If myF = False Then MsgBox "画像を選択してください(終了)" Exit Sub End If '===============画像の掃除 For Each mySp In ActiveSheet.Shapes myAD1 = mySp.TopLeftCell.MergeArea.Address myAD2 = Target.Address If myAD1 = myAD2 Then mySp.Delete Next '===============画像の貼り付け Set mySp = ActiveSheet.Shapes.AddPicture(Filename:=myF, LinkToFile:=False, _ SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _ Width:=0, Height:=0) '★　とりあえず　縦横０で。 mySp.ScaleHeight 1, msoTrue '★元のサイズに戻す mySp.ScaleWidth 1, msoTrue '★元のサイズに戻す '===============タテヨコの縮尺を保持 If mySp.Width > Target.Width Then mySp.Width = Target.Width If mySp.Height > Target.Height Then mySp.Height = Target.Height '===============中央へ調整 myHH2 = (Target.Height / 2) - (mySp.Height / 2) myWW2 = (Target.Width / 2) - (mySp.Width / 2) mySp.Top = Target.Top + myHH2 mySp.Left = Target.Left + myWW2 Set mySp = Nothing End Sub

  • エクセル２００７のVBAの困りごと

    教えてください。 画像挿入時にエクセルのセルの大きさに合わせるマクロを使っているのですが、エクセル２０００、２００３では問題なく動くのですが、２００７だと、うまくVBAが動かず、画像が縮小・拡大されません。 わかるかた教えてください。 コード 　Dim c As Range, cm As Range Application.ScreenUpdating = False For Each c In Selection Set cm = c.MergeArea If c.Address = cm.Item(1).Address Then If Application.Dialogs(xlDialogInsertPicture).Show = False 　　　Then Exit Sub 　With Selection .Left = cm.Left .Top = cm.Top .Height = cm.Height .Width = cm.Width End With End If Next Set cm = Nothing

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する