エクセルの画像貼り付けマクロについて

このQ&Aのポイント
  • エクセルの画像貼り付けに関するマクロの設定方法について説明します。
  • キャンセルを押した場合にダイアログが閉じる設定方法と、貼り付けた画像の削除方法についてお知らせください。
  • 緊急な質問ですので、ご回答をお願い致します。
回答を見る
  • ベストアンサー

エクセルの画像貼り付けマクロについて

Sub 画像挿入() ActiveSheet.Unprotect Password:="pass" Application.Dialogs(xlDialogInsertPicture).Show If Dialog1.Show Then With ActiveSheet.Pictures(1) .Top = Range("D31").Top .Left = Range("D31").Top Selection.ShapeRange.IncrementLeft -126# Selection.ShapeRange.IncrementTop 21.75 End With ActiveSheet.Protect Password:="pass", DrawingObjects:=True, _ contents:=True, UserInterfaceOnly:=True End Sub 現在、ダイアログ表示で画像を貼り付けられるように設定しています。 2点質問があり、お答えしていただければと思います。 まず、ダイアログ表示時にキャンセルを押した場合エラーメッセージが 出てきますので、キャンセルを押した場合にダイアログが閉じるように 設定する。 2点目が、間違えて貼り付けてしまった画像を削除する事。 保護をマクロの後にしますので、貼り付けてしまったらその画像を 選択して削除が出来ません。 削除ボタンで貼り付けた画像を削除したいのですがいい方法は ございますでしょうか? 緊急ですのでどなたかお答え頂けますでしょうか、よろしくお願い致します。

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

  • ベストアンサー
  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.1

1点目 Application.Dialogs(xlDialogInsertPicture).Show を Dim rtn rtn = Application.Dialogs(xlDialogInsertPicture).Show If rtn = False Then Exit Sub にすればOK 2点目 > 削除ボタンで貼り付けた画像を削除したいのですが 削除ボタンって何ですか? 自前のマクロを走らせるボタンなのであれば、マクロで保護解除したらどうですか?

yu-cci_001
質問者

お礼

参考にさせて頂きました、何とかなりそうです。 削除ボタンって言うのは貼り付けたあとに、削除を押すと 貼り付けた画像が消えるというマクロです。 こちらも解決に向かっています、ありがとうございました。

その他の回答 (1)

  • end-u
  • ベストアンサー率79% (496/625)
回答No.2

あまり良くない案かもしれませんが Sub try()   If Application.Dialogs(xlDialogInsertPicture).Show Then     With ActiveSheet       .Unprotect Password:="pass"       Selection.OnAction = "deltest"       .Protect Password:="pass", _            DrawingObjects:=True, _            contents:=True, _            UserInterfaceOnly:=True     End With   End If End Sub Sub deltest()   If MsgBox("del?", vbOKCancel) = vbOK Then     ActiveSheet.Pictures(Application.Caller).Delete   End If End Sub ...と、Pictureに削除マクロを登録、という手もありますね。 貼り付け位置はその時のActiveCellです。 適当にアレンジしてください。

yu-cci_001
質問者

お礼

上記同様大変参考になりました。 操作自体は難しくなく、何とかなりそうです。 お二人ともありがとうございました。

関連する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 ところどころ端折ってますが,以上のようなマクロです. よろしくお願いします.

  • エクセル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で複数の図に名前をつけたい

    エクセルVBAで複数の図に名前をつけたい エクセルで見出しと合計2カ所などウィンドウ枠固定を複数つける ことはできないので、かわる方法として図のリンク貼り付けを利用 しようと思い下記を作りました。 Sub test()   Range("A100", "R100").Select   Selection.Copy   Range("A1").Select   ActiveSheet.Pictures.Paste link:=True   ActiveSheet.Pictures.ShapeRange.Name = "合計1"   Range("A200", "R200").Select   Selection.Copy   Range("A2").Select   ActiveSheet.Pictures.Paste link:=True   ActiveSheet.Pictures.ShapeRange.Name = "合計2" ・・・(1) End Sub 必要に応じて合計1または合計2を削除します Sub 図1削除() ActiveSheet.Shapes("合計1").Delete End Sub Sub 図2削除() ActiveSheet.Shapes("合計2").Delete End Sub (1)のところで 「このメンバにアクセスできるのは、単一の図形の場合だけです」エラーになります。 エラーがでないように図に名前をつける方法をおしえていただけないでしょうか。 何卒よろしくお願い致します

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

    エクセルに画像を貼付け縮小する作業をマクロにしたいのですが、 分からない部分があって困ってます。 (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

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

    以下のマクロで、シート上にある図形(四角形 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 移動ではなくコピーにするには、どう変えればいいでしょうか?

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

    エクセル(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"はオブジェクトの名前のようですが、名前がわかっていないオブジェクト(但し上記マクロで書いたので場所はわかっている)を選択するにはどうしたらいいでしょうか。

  • 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

  • EXCELのVBAによる写真貼り付け時に重なる。

    VBAの初心者です。 エクセルに写真データを貼り付けるVBAで、以下のマクロを実行するとシートの同じセル位置B5に、写真が2枚重なった状態となります。 セルのB5とH5の位置に写真をそれぞれ貼りつけるために、どのように修正すればよいのでしょうか?ご教授ください。 OS:Vista ソフト:Excel2007 Sub 写真ファイル呼び出し() ' Sheets("風景1").Select Range("B5").Select ActiveSheet.Pictures.Insert(Worksheets("風景写真").Range("o4").Value).Select With Selection Selection.ShapeRange.LockAspectRatio = msoTrue '縦横比を固定するコマンド Selection.ShapeRange.Width = 245 '縦横比固定、幅のみを指定する End With 'Sheets("風景2").Select Range("H5").Select ActiveSheet.Pictures.Insert(Worksheets("風景写真").Range("o5").Value).Select With Selection Selection.ShapeRange.LockAspectRatio = msoTrue '縦横比を固定するコマンド Selection.ShapeRange.Width = 245 '縦横比固定、幅のみを指定する End With End Sub

専門家に質問してみよう