Excelでセル上の画像を別のセルにコピーする方法とは?

このQ&Aのポイント
  • Excelでセル上の画像を別のセルにコピーする方法について教えてください。
  • セル上の画像を別のセルにコピーする方法がうまくいかない場合の対処法を教えてください。
  • 画像をコピーした後に、コピー先のセルの高さと幅にフィットさせる方法について教えてください。
回答を見る
  • ベストアンサー

Excelでセル上の画像を別のセルにコピーするには

いつも楽しく勉強させていただいております。 つぎのような処理をしたいのですが、うまくいきません。 1.セル1の上にある画像をセル2の上にコピーする。 2.コピーした画像をセル2の高さと幅にフィットさせる。 まず、このようなマクロを考えてみました。 Range("A1").CopyPicture Range("C1").Select ActiveSheet.Paste ActiveSheet.Shapes(Selection.Name).LockAspectRatio = msoFalse ActiveSheet.Shapes(Selection.Name).Top = Range("C1").Top ActiveSheet.Shapes(Selection.Name).Left = Range("C1").Left ActiveSheet.Shapes(Selection.Name).Height = Range("C1").Height ActiveSheet.Shapes(Selection.Name).Width = Range("C1").Width これですと元の画像がA1のセルより小さい場合、周囲に余白がある形でコピーされてしまいます。 C1にコピーしたら余白はなしでC1の大きさいっぱいに画像を引き延ばしたい(あるいは縮小したい)のです。 そこで次のように変更してみました。 (上のプログラムと一番上の行のみが違います)。 ActiveSheet.Shapes("図 6").Copy Range("C1").Select ActiveSheet.Paste ActiveSheet.Shapes(Selection.Name).LockAspectRatio = msoFalse ActiveSheet.Shapes(Selection.Name).Top = Range("C1").Top ActiveSheet.Shapes(Selection.Name).Left = Range("C1").Left ActiveSheet.Shapes(Selection.Name).Height = Range("C1").Height ActiveSheet.Shapes(Selection.Name).Width = Range("C1").Width これもうまくいきません。 A1にある元の"図 6"は動かしたくないのに、勝手にB1の位置に移動してしまいます。 というのは、"図 6"という画像をコピーすると、同じ名前で画像ができちゃうんですね。 コピー元とコピー先の両方の画像に対して位置や高さを設定することになるようです。 ということで、 1.セル1の上にある画像をセル2の上にコピーする。 2.コピーした画像をセル2の高さと幅にフィットさせる。 これを実現させるにはどうしたらいいでしょう。

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

  • ベストアンサー
  • kybo
  • ベストアンサー率53% (349/647)
回答No.3

>1. そうです。 >2. こんな感じです。 Sub macro() Dim C As Shape, N As String For Each C In ActiveSheet.Shapes If C.TopLeftCell.Address = "$A$1" Then N = C.Name Exit For End If Next C MsgBox N End Sub

その他の回答 (2)

  • kybo
  • ベストアンサー率53% (349/647)
回答No.2

ボタンもあったのですね。 では、こういうのはどうでしょうか? ActiveSheet.Shapes("図 6").Select With Selection.ShapeRange.Duplicate .LockAspectRatio = msoFalse .Top = Range("C1").Top .Left = Range("C1").Left .Height = Range("C1").Height .Width = Range("C1").Width End With

meglin888
質問者

お礼

kyboさん、今回はうまくいきました! 教えてくださいばかりで申し訳ないのですが、 1.With Selection.ShapeRange.Duplicateとすると、   コピーした方の図を指すという理解で合っていますか。 2.最初にShapes("図 6")と決め打ちしましたが、   A1セルに(左上が)ある図の名前を取得することはできますか。 For Each XXX In ActiveSheet.Shapes ・・・ Next 上記のコードでシート全体の図を全部チェックしてそれらの位置するセルを取得というのは可能かと思うのですが、「A1セルにある図」でピンポイントで探すことは可能でしょうか。

meglin888
質問者

補足

↓の質問1だけ解決です。検索してみたらShapeRange.Duplicateで「オブジェクトを複製し、複製への参照を返します。」とありました。

  • kybo
  • ベストアンサー率53% (349/647)
回答No.1

Excelのバージョンは2007でしょうか?2010では問題ありません。 以下の様にしてみて下さい。 ActiveSheet.Shapes("図 6").Copy Range("C1").Select ActiveSheet.Paste ActiveSheet.Shapes(ActiveSheet.Shapes.Count).LockAspectRatio = msoFalse ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Top = Range("C1").Top ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Left = Range("C1").Left ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Height = Range("C1").Height ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Width = Range("C1").Width

meglin888
質問者

お礼

kyboさん、回答ありがとうございます。バージョンを書き忘れていましたが、2007です。 教えていただいたコードを試してみました。ところが位置や幅のプロパティの設定がどういうわけか貼り付けた画像でなく同じシートにあるコマンドボタンに働きかけてしまい、コマンドボタンがセルC1の中にすっぽり収まっていました。 ActiveSheet.Shapes.Countは必ずしも直近に追加されたオブジェクトを指すとは限らないのでしょうか・・・。

関連するQ&A

  • エクセル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 省ける箇所や分割する方法などありましたら教えてください。

  • エクセルでリンクされたイメージが表示できません

    エクセルでリンクされたイメージが表示できませんとたまに表示されます。 この理由はどうしてですか? 画像は下記のVBAを用いてセルC113に貼っています。 Sub 貼付() ActiveWindow.View = xlNormalView Range("C113").Select myFileName = "C:\凡例.bmp" '---挿入する画像ファイルの指定 'Cells(113, 3).Select 'ActiveSheet.Pictures.Insert Filename:=myFileName '---選択位置に画像を挿入 Set myShape = ActiveSheet.Shapes.AddPicture(Filename:=myFileName, _ LinkToFile:=True, SaveWithDocument:=False, Left:=Selection.Left + 50, _ Top:=Selection.Top, Width:=200#, Height:=100#) end sub

  • 図形をコピーするマクロ(エクセル)

    以下のマクロで、シート上にある図形(四角形 1)を、選択状態にあるセルの上に移動させることができます。 Sub test() Dim seru As Range On Error GoTo Errorline Set seru = Range(ActiveCell.Address) ActiveSheet.Shapes("四角形 1").Select With Selection.ShapeRange .Left = seru.Left .Top = seru.Top End With Errorline: End Sub 移動ではなくコピーにするには、どう変えればいいでしょうか?

  • Excel 2010マクロで挿入した画像に名前が付けられない!

    Excel 2010マクロで挿入した画像に名前が付けられない! Excel 2002で作成・使用していた画像挿入修正マクロを、Excel 2010で実行したところ、 下記プログラムの下から二行目の「ActiveSheet.Shapes(na11).Name = "ga1"」部分で 「指定したコレクションに対するインデックスが境界をこえています」とのことで エラー!になります。 na11 = Selection.ShapeRange.ZOrderPosition ActiveSheet.Shapes(na11).Name = "ga1" 上記の部分のみを、Excel 2010で実行すると正常に作動します。 原因がわかりません。ご指導よろしくお願いいたします。 ※下記プログラムの「¥」は文字化けするため、全角に置き換えております。 ------------------------------------------------------ ' 画像(1)を自動配置する If Range("AQ18").Value = 0 Then Else san = Range("DA17").Value san2 = Right(san, Len(san) - InStrRev(san, "-") + 1) d = Left(san, Len(san) - Len(san2)) myPath = pa & "¥" & a & "¥" & a & " " & b & " " & k & "¥" & d & "¥" & d & "-PHOTO" & "¥" & d & "_web" Range("H42").Select ActiveSheet.Pictures.Insert(myPath & "¥" & san).Select ' 画像(1)を縮小し、名前を付ける Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Width = size1 Selection.ShapeRange.Rotation = 0# na11 = Selection.ShapeRange.ZOrderPosition ActiveSheet.Shapes(na11).Name = "ga1" End If --------------------------------------------------

  • エクセルで線の太さと色を変えるマクロ

    マクロ初心者です。ご教示願います。 エクセルのマクロで選択した任意のセルに●→を引くマクロを組みましたが、 線の太さと、色を変えるコードをどこにどう入れたらいのか教えてください。 Sub 線を引く() Dim TP, LF, WD TP = Selection.Top + (Selection.Height / 2) LF = Selection.Left WD = Selection.Width ActiveSheet.Shapes.AddShape(msoShapeOval, LF, TP - 3, 6, 6).Select ActiveSheet.Shapes.AddLine(LF + 6, TP, LF + WD, TP).Select

  • Shape画像保存モードの事後変更

    VBA Excel2007を使用しています。 画像を読み込むために、例えば、 Dim picture As Shape Set picture = ActiveSheet.Shapes.AddPicture(filename:=filename, LinkToFile:=msoTrue, SaveWithDocument:=msoFalse, Left:=Selection.Left, Top:=Selection.Top, Width:=0, Height:=0) のように、一旦、画像を「文書とともに保存しない」モードで読込み、後にそのShape画像を「文書とともに保存する」ように変更することは、可能でしょうか。

  • エクセルのマクロについて

    エクセル2010を使用しています。 図面中の図形描画で描かれた四角のオブジェクトを 結合したセル(G7:H8)の中央に移動させるマクロを組みました。 マクロを組み実行したところ、動作はOKなのですが、 保存の際エラーが発生し修復しますか?となってしまいます。 続行すると、 修復されたレコード: /xl/drawings/drawing1.xml パーツ内のスケッチ (図形描画) と表示されます。 作成したマクロは以下の通りです。 おかしいところをご指摘ください。 よろしくお願いします。 Sub 打合図() ' ' 打合図 Macro ' ActiveSheet.Shapes.Range(Array("AutoShape 12")).Select Selection.Cut Range("G7:H8").Select ActiveSheet.Paste With Selection .Top = (Range("G9").Top - Range("G7").Top - .Height) / 2 + Range("G7").Top .Left = (Range("I7").Left - Range("G7").Left - .Width) / 2 + Range("G7").Left End With Range("N8").Select End Sub

  • 選択したセルにピッタリ合うオートシェイプの挿入

    よろしくお願いいたします。 下記のコードは行方向では選択したセルとピッタリに四角のオートシェイプが挿入できるのですが、列方向では常に1行です。 横方向も選んだ範囲だけ広がるようにするにはどう変えたらよいでしょうか。 Set shrect = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ Selection.Left, Selection.Top, Selection.Offset(0, 1).Left - Selection.Left, _ Selection.Height)

  • エクセルで貼り付けた写真のサイズを減らすためにコピーしましたが、位置がうまく行きません

     以前、エクセルにマクロで貼り付けた写真のサイズを減らすために、コピーする方法を教えて頂いたのですが、 下のように書いたコードでは指定した位置にコピーの写真が貼り付きません。  どこがおかしいのでしょうか? sFile = pathname & "\" & filemei & ".jpg" Set myPic = ActiveSheet.Pictures.Insert(sFile) j = ((2 * i) \ 10) * 2 + 2 ←表示させたいセルの行 k = (2 * i) Mod 10 + 2   ←表示させたいセルの列 With myPic.ShapeRange   .Left = Cells(j, k).Left   .Top = Cells(j, k).Top   .LockAspectRatio = msoFalse   ' ↓サイズを指定   .Height = Cells(j, k).Height   .Width = Cells(j, k).Width End With myPic.Locked = True '上の写真をコピーして貼り付け、下の写真を削除する With myPic   .Copy   ActiveSheet.Pictures.Paste   .Left = Cells(j, k).Left   .Top = Cells(j, k).Top ←このセル位置にコピーを貼り付けたいのですが   '元の写真を削除   .Delete End With  以上のようなコードです。  コピー元の写真は指定どおりの位置に表示された後削除されますが、 コピーした写真は全て最初のコピー位置に張り付いてしまいます。  画像の扱いをよく理解していませんのでおかしな所も多々あると思いますが よろしくお願いします。

専門家に質問してみよう