エクセルマクロ 画像を所定の位置に貼り付けるには?

このQ&Aのポイント
  • エクセル上でボタンを押すと写真データーを所定の位置に貼り付ける方法が分からない。
  • excel2010以降でリンク張付になってしまい、保存していた書類から写真が消えてしまう問題が発生。
  • マクロの修正中に座標を指定して画像を貼り付けようとしているが、エラーが発生してうまくいかない。
回答を見る
  • ベストアンサー

エクセルマクロ 画像を所定の位置に貼り付けるには?

エクセル上でボタンを押すと写真データーを所定の位置に貼り付ける 書式(excel2003で作成)を使っています。 excel2010になってから、皆さんが質問されているようにリンク張付になってしまい 保存していた書類から写真が消えてしまいました。 今は作成したらPDFで保存していますが、修正ができません。 そこで、ネットでいろいろ検索して、マクロをいじっているのですが、 コピー→削除→ペースト(セルの位置)まではなんとかできたのですが 指定した位置に貼り付ける方法が分かりません。 よろしくお願いします。 修正中のマクロが下記です。 Sub select_pic() Dim tt, ttl, Item As String Dim FileNamePath As Variant 'ファイルのパスを取得します tt = "写真 ファイル (*.jpg),*.jpg" ttl = "写真ファイルを選択してください" FileNamePath = SelectFileNamePath(tt, ttl) If FileNamePath = False Then 'キャンセルボタンが押された  End End If ActiveSheet.Pictures.Insert(FileNamePath).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Width = 263 Selection.ShapeRange.Left = 12 Selection.ShapeRange.Top = 45 Selection.CopyPicture Selection.Delete ActiveSheet.Paste End Sub  最後のPasteの前後に座標を入れればいいのだと思いますが エラーが出てだめです。分かる人にとっては簡単なのでしょうが よろしくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • xls88
  • ベストアンサー率56% (669/1189)
回答No.1

こんな感じでどうでしょうか。 (例1) With Activesheet .Paste With .Pictures(.Pictures.Count) .Left = 100 .Top = 50 End With End With (例2) With Activesheet .Paste With .Pictures(.Pictures.Count) .Left = ActiveCell.Left .Top = ActiveCell.Top End With End With (例3) With Activesheet .Paste With .Pictures(.Pictures.Count) .Left = Range("B2").Left .Top = Range("B2").Top End With End With

casio777
質問者

お礼

早速ご回答いただき、ありがとうございます。 例1を入力して、座標値を変えたらできました。 助かりました。 例2や例3についてもいろいろやってみたいと思います。ありがとうございました。

関連するQ&A

  • エクセル マクロ picture

    教えてもらいながら以下のような画像貼り付けマクロを組んだのですが,以下の点に引っかかり前進することができません. 教えて頂きたいと思い投稿しました. 躓いている点  シート内でボタンを利用して貼り付け及び削除をしているのですが,エクセルシート内でコピペするたびに「Selection.Name」と貼り付け先を修正しています. →これをコピペしても修正をしなくてもよいマクロはないでしょうか? 自作作成マクロ Sub 写真貼付1_Click() Dim AA As String, BB As String, CC As String 10 AA = InputBox("参照先を指定して下さい。例:D:\Photo001.jpg", "場所指定", AA) If (AA = "") Then AA = Application.GetOpenFilename(Title:="写真ファイルの場所はどこですか?") GoTo 10 End If ActiveSheet.Unprotect Range("m29").Select ActiveSheet.Pictures.Insert(AA).Select Selection.Name = "写真1" Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 310 Selection.ShapeRange.Width = 310# Selection.ShapeRange.IncrementLeft 1 Selection.ShapeRange.IncrementTop 1 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True End Sub -------------------------------------------------- Sub 写真削除1_Click() ActiveSheet.Shapes("写真1").Select Selection.Delete ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True End Sub ところどころ端折ってますが,以上のようなマクロです. よろしくお願いします.

  • エクセルに画像を貼付け縮小する作業をマクロにしたいのですが、

    エクセルに画像を貼付け縮小する作業をマクロにしたいのですが、 分からない部分があって困ってます。 (1)挿入したいセルにカーソルを合わせる (2)マクロ  挿入-図-ファイル-図の挿入-図の書式設定-サイズ-30% この作業を覚えさせると以下になりました。 Sub Macro3() ActiveSheet.Pictures.Insert("C:\Documents and Settings\デスクトップ\1.JPG") _ .Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 360# Selection.ShapeRange.Width = 480# Selection.ShapeRange.Rotation = 0# End Sub これだと、写真が指定されてしまいます。 マクロの途中で止まって任意の写真を都度選べるようにできますか? 膨大な量の写真をセルに並べていきたいのです。

  • Excel マクロのエラーを直したいです。

    いつもお世話になっております。 さて、下記マクロを作成(コピー&ペースト)したのですが、矢印以外のあみかけ、罫線などがセルに表示されてしまいます。 どのように修正すれば、矢印だけが表示されるようになるのでしょうか? 修正頂ければ、幸甚です。宜しくお願い致します。 ※マクロ初心者です。 (1)Sub 外部デイ利用() Dim TP, LF, WD TP = Selection.Top + (Selection.Height / 2.5) LF = Selection.Left WD = Selection.Width ActiveSheet.Shapes.AddLine(LF, TP, LF + WD, TP).Select Selection.ShapeRange.Line.Weight = 1# Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle End Sub (2)Sub 認知デイ利用() Dim TP, LF, WD TP = Selection.Top + (Selection.Height / 2.5) LF = Selection.Left WD = Selection.Width ActiveSheet.Shapes.AddLine(LF + 6, TP, LF + WD, TP).Select Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadOval Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle End Sub

  • エクセル2007でマクロを使った写真挿入がうまくいきません。

    エクセル2007でマクロを使った写真挿入がうまくいきません。 エクセル2003で使っていたひな形をもらったのですが2007では結合したセルから ずれてしまいます。 どうすれば位置の修正をできますか? また、結合した大きなセルの中にフォームボタンを付けいるのですが 2003では写真が挿入されるとボタンは隠れてしまっていたのですが、 2007では挿入した写真に重ねって写真が見ずらいです。 隠すことはできるのでしょうか? なにぶん初心者なのでお願いします。 Sub Pic_in() ' マクロ記録日 : 2003/7/1 kome fname = Application.GetOpenFilename ActiveSheet.Pictures.Insert(fname).Select Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Height = 247.5 Selection.ShapeRange.Width = 350 End Sub

  •  エクセルに写真を挿入するマクロを組んでいます。

     エクセルに写真を挿入するマクロを組んでいます。 2003までは問題なく動作していたマクロが、 2007では位置調整がうまく行きません。  そこでネットで検索して With Selection .Left = Range("C6").Left .Top = Range("C" & rowa).Top End With のように Selection.Left を使えば解決するとありましたが、 (1)WIN VISTAのエクセル2007では おなじひとつのエクセルファイルの あるシートではコード通りが位置でるのに 違うシートでは縦位置がずれる。 (2)WIN XPのエクセル2007では すべてのシートで縦位置がずれる。 ただし、ずれの位置は(1)よりは少ない。 といずれのOSでも不具合が出ます。  事情によりエクセル2007でこのマクロを使用しなければならなくなり 非常に困っております。 どなたか解決方法をご存知の方、よろしくお願いします。  なお、(2)のWIN XPでは、エクセル2003も入っており、 その中では、全く問題なくマクロが動作しています。 実際のコードは下の通りです。 Sub 写真呼出(koumoku, jpgf, tr As Variant) Dim rowa As String ActiveWindow.ScrollColumn = 1 ActiveWindow.ScrollRow = tr ←選択したセルの行ナンバー ActiveSheet.Pictures.Insert(motopath & "写真\" & koumoku & "\" & jpgf & ".JPG").Select Selection.Name = "写真" Selection.ShapeRange.LockAspectRatio = msoTrue '縦横比の固定 Selection.ShapeRange.Height = 480 'Selection.ShapeRange.IncrementLeft 100 ←不具合が出たので止めた部分 'Selection.ShapeRange.IncrementTop 40  ←不具合が出たので止めた部分 rowa = tr + 2 With Selection .Left = Range("C6").Left .Top = Range("C" & rowa).Top End With End Sub

  • エクセルマクロでオブジェクトを選択する方法

    エクセル(2002)を使っています。マクロの記録機能を使って円を描くマクロを作成しました。 Sub Maru(xpos, ypos, hankei) ActiveSheet.Shapes.AddShape(msoShapeOval, xpos, ypos, hankei, hankei).Select Selection.ShapeRange.Fill.Visible = msoFalse Selection.ShapeRange.Fill.Solid Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoTrue Selection.ShapeRange.Line.ForeColor.SchemeColor = 64 Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) End Sub 次にこの円を削除したいと思い、同じようにマクロの記録機能を使ったところ、 Sub Macro3() ActiveSheet.Shapes("Oval 64").Select Selection.Delete End Sub となりました。"Oval 64"はオブジェクトの名前のようですが、名前がわかっていないオブジェクト(但し上記マクロで書いたので場所はわかっている)を選択するにはどうしたらいいでしょうか。

  • コメント挿入マクロ挿入位置ずれの件

    コメント挿入マクロ挿入位置ずれの件 エクセル2007 ウインドウズ7利用 エクセルセル内の品番に対し別ファイルに保存してある同じ品番の画像をセルに挿入するマクロを組んで頂いたのですが品番を記載したセルからずれた所に画像が挿入されます。 挿入する画像が数百枚単位となりますので現在全画像を選択して移動するのも時間がかかってしまいます。品番が記載されたセルへ挿入する方法があれば教えていただけますでしょうか。 記 Sub 画像挿入() Dim 対象セル As Range For Each 対象セル In Selection If Dir("C:\画像\" & 対象セル.Value & ".jpg") <> "" Then '該当するファイルがあれば ActiveSheet.Pictures.Insert("C:\画像\" & 対象セル.Value & ".jpg").Select Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Height = 対象セル.Height Selection.ShapeRange.Width = 対象セル.Width Selection.ShapeRange.IncrementLeft 対象セル.Left Selection.ShapeRange.IncrementTop 対象セル.Top End If Next 対象セル End Sub です。宜しく御願い致します。

  • エクセル2007のマクロで画像挿入がうまくいきません。

    エクセル2007のマクロで画像挿入がうまくいきません。 写真のサイズ縦横比がセルにあっていないので伸びてしまいます。 下記のプログラムでサイズ変更も可能でしょうか? フォームのボタンの上に張り付けた場合、ボタンを隠す事は 出来ますか? ボタンの色は変更できるのでしょうか? いろいろわがままな質問で申し訳ありません。 マクロ初心者です。 Sub Pic_in2007() fname = Application.GetOpenFilename ActiveSheet.Pictures.Insert(fname).Select Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Height = range("B5:C6").height Selection.ShapeRange.Width = range("B5:C6").width Selection.ShapeRange.left = range("B5:C6").left Selection.ShapeRange.top = range("B5:C6").top End Sub

  • VBAで画像を自動で切り替える方法

    Excelで棚割表を作っています。商品コードを打つとその商品の画像を自動で表示させたいのですが、雑誌を見ながらコードをアレンジしてほぼ完成したのですが、「プロシージャーが大きい」とエラーが出てマクロを実行出来ません。 画像は100個程度あり、先に別のマクロで貼り付けてあります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ファイル As String If Intersect(Target, Range("A4")) Is Nothing Then ActiveSheet.Shapes("画像").Delete ファイル = "C:\保存場所\" & Range("A4").Value & ".jpg" Range("B5").Select ActiveSheet.Pictures.Insert(ファイル).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Top = ActiveCell.Top Selection.ShapeRange.Left = ActiveCell.Left Selection.ShapeRange.Height = 97 Selection.ShapeRange.Width = 52.5 Selection.ShapeRange.Rotation = 0# Selection.ShapeRange.IncrementLeft 1.5 Selection.ShapeRange.IncrementTop 1.5 Selection.Name = "画像" End If (中略) Dim ファイル98 As String If Intersect(Target, Range("U60")) Is Nothing Then Exit Sub ActiveSheet.Shapes("画像98").Delete ファイル98 = "C:\保存場所\" & Range("U60").Value & ".jpg" Range("V61").Select ActiveSheet.Pictures.Insert(ファイル98).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Top = ActiveCell.Top Selection.ShapeRange.Left = ActiveCell.Left Selection.ShapeRange.Height = 97 Selection.ShapeRange.Width = 52.5 Selection.ShapeRange.Rotation = 0# Selection.ShapeRange.IncrementLeft 1.5 Selection.ShapeRange.IncrementTop 1.5 Selection.Name = "画像98" End Sub 省ける箇所や分割する方法などありましたら教えてください。

  • Excel マクロ 任意のセルから実行したい

    こんにちは、Excel2003を使用しています。 ExcelでK55からE55までのセルの値を削除して(空白にして) それぞれに「---を引いた透明のダイアローグボックス」を コピーしていくマクロを作成したことがあります。 このときは開始するセルがK55と決まっていたのですが 今度は任意のセルから(たとえば選択したセルの右隣とか) 実行したいのですがどのようにマクロを作ればよいでしょうか ご存じの方お教えください。 なお参考に上記のマクロを記載します。 Range("E55:J55").Select Selection.ClearContents Range("H55").Select ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 672#, 729#, _ 81#, 13.5).Select Selection.Characters.Text = "" With Selection.Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.ShapeRange.Fill.Visible = msoFalse 'Selection.ShapeRange.Fill.Solid 'Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoFalse ActiveSheet.Shapes("Text Box 12").Select Selection.Characters.Text = "---" With Selection.Characters(Start:=1, Length:=3).Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.HorizontalAlignment = xlCenter Range("K55").Select ActiveSheet.Shapes("Text Box 12").Select Selection.Copy Range("I55").Select ActiveSheet.Paste Range("H55").Select ActiveSheet.Paste Range("G55").Select ActiveSheet.Paste Range("F55").Select ActiveSheet.Paste Range("E55").Select ActiveSheet.Paste Range("E56").Select Selection.Copy Range("F56:J56").Select ActiveSheet.Paste Application.CutCopyMode = False Range("E56:J56").Select Selection.Copy Range("E57:E59").Select ActiveSheet.Paste Application.CutCopyMode = False Range("K59").Select End Sub

専門家に質問してみよう