- ベストアンサー
エクセル2002マクロ オートシェイプの消去方法を教えて下さい
エクセルでB5～F18に掛けて表があります。 この表は毎日１表ずつ分あり、使わない日は右上から左下に向かって斜線を引きます。 オートシェイプで引いた線をマクロで記録して引いているのですが、誤って引いてしまった時の消去マクロが作れないかな、と考えているのですが、可能でしょうか？ マクロの記録で、オートシェイプをクリックしてDeleteとやってみたのですが、うまくいきません。 どうやら線を引くたびに番号がつくらしく、その番号の線を消す、という風に記録してしまう為、エラーになってしまうようです。 表に斜線が引ければ良い訳で、他に方法があるのならそれで構いませんし、表は印刷してペーパーで保管しています。 何か良い方法がありましたら、宜しくお願い致します。 ちなみに今、描写の為に使っているマクロは下記の通りです。 Sub Macro2() ActiveSheet.Shapes.AddLine(15.75, 59.25, 323.25, 475.5).Select Selection.ShapeRange.Flip msoFlipHorizontal End Sub
- du-sama
- お礼率52% (57/108)
- オフィス系ソフト
- 回答数7
- ありがとう数3
- みんなの回答 （7）
- 専門家の回答
質問者が選んだベストアンサー
＞どうやら線を引くたびに番号がつくらしく その通りのようですよ。 ＞その番号の線を消す、という風に記録してしまう為、エラーになって マクロの記録の限界ですね。この線（オブジェクト）の指定を相対化するのが勉強の難しいところと思います。 －－－－ Sub test03() Dim 図形 As Shape For Each 図形 In ActiveSheet.Shapes If 図形.Type = msoLine Then 図形.Delete '図形を削除する End If Next End Sub これを実行してみて、いかがでしょうか。 （参考） 名前の捉え方 Sub test02() n = Selection.Name MsgBox n Worksheets("sheet5").DrawingObjects(n).Delete End Sub Ｓｈｅｅｔ名は適宜変えるか、Activesheetでも良い。
その他の回答 (6)
＃２です 対象のコピーはしていないです。 オブジェクトを全部削除。 オートシェイプで斜線を引いておく（全て） マクロの記録でオブジェクトの選択 一つづつ連続選択 マクロ記録を停止 マクロの編集で ActiveSheet.Shapes("Line 1").select ActiveSheet.Shapes("Line 2").select ActiveSheet.Shapes("Line 1").visible = true '表示 ActiveSheet.Shapes("Line 2").visible = false '非表示 で出来るはずなんですが
お礼
("Line 1")の部分が引く度に数字が増えていってしまうので、うまくいかないようです。斜線は引く日が決まっている訳ではなく、誤って引いて消去したい時も何番目の斜線なんだか予測出来ないので・・・。うまくは行きませんでしたが考えていただいてありがとうございました(^^)
- imogasi
- ベストアンサー率27% (4737/17068)
＃３です。 その補足の ＞、範囲を指定して消去することは出来るんでしょうか 一晩考えたけれど、私のできる程度では良い方法はない。 （１）名前で判別 自分で分類した名前を付ければ,あるいは区別できるかも知れないが、多数あれば面倒だし、プログラム内固定なので事後増減すればお手上げ？。 Sub Macro2() ActiveSheet.Shapes.Range(Array("Rectangle 9", "Line 10", "Oval 11")).Select Selection. のＡｒｒａｙの中を充実する。 （２）グループ化 グループ化が出来るようなので、これが使えるかも知れないが。捉え方（ネーミング）が私には判らないので勉強します。ただし事後の使用者の増減にはお手上げ？ （３）位置 「.Top」「,Left」の２つで範囲内にある図形かどうか 判別する。これも面倒そう。
お礼
度々ありがとうございます。範囲指定は難しそうですね・・・。前記の全部消去する方法で充分です(^^)ありがとうございました。
- BLUEPIXY
- ベストアンサー率50% (3003/5914)
＞表には文字や計算式が入っていて #4です。 そうですね。私は、バカでした。いい加減なことをいってすみません。 ＃２で、左右反転するのは、 「Flip msoFlipHorizontal」だからです。 表の位置が決まっているなら ＃２で言われるように、あらかじめ引いておいて、非表示にするのがいいかもしれませんね。
- BLUEPIXY
- ベストアンサー率50% (3003/5914)
セルを結合して罫線の斜線を引くマクロと 罫線の斜線を消去してセルの結合を解除するマクロ を作るといいと思います。
補足
表には文字や計算式が入っていて、見た目を崩さずに上から線を引きたいんです。セルを統合してしまうと罫線や文字が消えてしまうんですよね。
＃１です 消す方法ではなく隠す方法 マクロの記録でオートシェイプを選択 コードを見て.selectを.visible=true trueの反対はfalseを書きます
補足
selectを.visible=trueに置き換えたら、表に最初のマクロで引いた線と左右対称な線が描写されました。visible=falseを入れてみたら、直前に描写された線が左右対称に反転？しました。やり方が悪かったんでしょうか…謎です(^^;
オートシェイプでは重くなります。 ctrl+1(テンキー不可) でダイアログを出します。 罫線タブで斜め線をひきます （セルをまたぐ場合は結合しないととダメ） 後は出来ますか
補足
表には文字や計算式が入っていて、見た目を崩さずに上から線を引きたいんです。セルを統合してしまうと罫線や文字が消えてしまうんですよね。
関連するQ&A
- Excelのマクロを使用してオートシェイプ図形の色を変えたいのです。
Excelのマクロを使用してオートシェイプ図形の色を変えたいのです。 オートシェイプ図形を５０個ならべて、マウスでクリックしてものは色が変わるようにしたいと思います。 マクロ記録をすると以下のようになりました。 Sub Macro1() ActiveSheet.Shapes("AutoShape 1").Select Selection.ShapeRange.Fill.ForeColor.SchemeColor = 45 Selection.ShapeRange.Fill.Visible = msoTrue Selection.ShapeRange.Fill.Solid End Sub このプログラムを５０個書くわけにはいかないのですが、プログラムで処理するのに問題点が２つ出てきました。 ・オートシェイプ図形の名前が"AutoShape 1"となっていますが、これを変更したいのですが、書式設定にはありませんでした。変更するにはどうすればよいのでしょう？ ・クリックしたオートシェイプ図形がどれであるかを返す関数がないと、どの図形がクリックされたかわからないのですが、これを返す関数はあるのでしょうか？ よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- エクセル２００７でのオートシェイプのマクロ記録
エクセル２００７でのオートシェイプのマクロ記録ができません。 エクセル２０００、エクセル２００３では、可能です（テスト済）。 ２００７でのオートシェイプのマクロ記録のやり方は何か特殊なのでしょうか。 たとえば、エクセル２００７の開発タブから「マクロの記録」を選び、楕円を描いてマクロ記録を終了し、ＶＢＥでそのマクロを開いても、題名等はあるものの sub 題名（）から 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"はオブジェクトの名前のようですが、名前がわかっていないオブジェクト（但し上記マクロで書いたので場所はわかっている）を選択するにはどうしたらいいでしょうか。
- ベストアンサー
- Visual Basic
- EXCEL オートシェイプの線を消す方法
よろしくお願いします。 ＥＸＣＥＬで オートシェイプで線を引きました。 ところがマクロで表の複写を組んでしまったために 複写と複写が重なり オートシェイプの罫線が同じ場所に1000ぐらい？に重なってしまいました。(もっと多いかもしれません。） しかしどうしてもそのシートを削除するわけにはいきません。 出来るだけ簡単に 1000回？重なっているだろうオートシェイプの罫線を 消す方法はありますか。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VB6 オートシェイプ描画
VB6 オートシェイプ描画 VB6でExcel,2000(ActiveSheet)にオートシェイプを使用したいのですが、エラーが出てしまいます。 コマンドボタンクリック時、エラー ------------------------------- 実行時エラー'1004': 指定された値は境界を超えています。 ------------------------------- AddLineは出来たのですが四角や円がこのエラーです。どこが間違えているのでしょうか？ 宜しくお願いします。 Private Sub CB13_Click() Dim xlApp As Excel.Application Set xlApp = GetObject(, "Excel.Application") xlApp.ActiveSheet.Shapes.AddLine 50, 50, 100, 100 '(OK) xlApp.ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 50, 100, 100).Select '(NG) Set xlApp = Nothing End Sub
- ベストアンサー
- Visual Basic
- エクセル マクロで引いた線の色設定が戻せない
エクセルで作成した、出席簿にマクロで 土日などに赤線で罫線の間に縦に オートシェィプ直線を引いています。 次に転出者の欄には、横に線をマクロで引いていますが 色が変えられません。 マクロ終了後もオートシェイプの線色は黒でも 、線を引くと赤のままです。 その線を選択して、色を変えないと 変えられない状態です。 マクロ終了前に、色をリセットする事は出来ませんか？ 下記の内容がマクロの一部です。 よろしくお願いします。 If yobi = doyo Or yobi = niti Then Cells(3, 2 + n).Activate If yobi = niti Then With Selection.Font .ColorIndex = 3 End With End If ActiveSheet.Shapes.AddLine(110.25 + 21.75 * (n - 1), 42, 110.25 + 21.75 * (n - 1), 651).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 '10=赤色 End If If yobi = "" Then ActiveSheet.Shapes.AddLine(110.25 + 21.75 * (n - 1), 14.25, 110.25 + 21.75 * (n - 1), 651).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 8 '8=黒色 End If
- 締切済み
- オフィス系ソフト
- VBAでオートシェイプのグループ化についての質問です。
VBAでオートシェイプのグループ化についての質問です。 オートシェイプ線（Line）で台形を作成し全てを選択し、グループ化したいと考えています。 また、連続して台形を作成していきたいと考えています。 ?4本線を引く ?グループ化（Aグループ） ?4本線を引く ?グループ化（Aグループ） ⇒ 連続して作成・・・ Dim st() As Variant Dim ob As Shape Dim MyLine As Shape '線の作成 Set MyLine = ActiveSheet.Shapes.AddLine(startX, startY, widthX, heightY) '線の選択 For Each ob In ActiveSheet.Shapes ReDim Preserve st(j) st(j) = ob.name j = j + 1 Next ob 'グループ化 Worksheets("test").Shapes.Range(st).Select Selection.ShapeRange.Group.Select と上記コードで一つのグループは作成出来たのですが、次に作成すると Worksheets("test").Shapes.Range(st).Select Selection.ShapeRange.Group.Select でエラーになります。 恐らく前のグループ化内の線も選択してしまうのではないかと思っていますが、対処の仕方が解りません。 線の作成方法から選択方法等いろいろ意見が聞きたいと思っています。 アドバイスよろしくお願いいたします。 m(__)m
- ベストアンサー
- その他（プログラミング・開発）
- エクセルで簡単なオートシェイプのマクロをつくりました マクロの実行とステップごとの実行の結果がちがってしまいます
オートシェイプを使った簡単な寸法線の入った図をマクロで書きました。 ステップごとだと期待どおりのアウトプットなのですが、ダイレクトにマクロを実行すると途中のステップがとんでしまうようです。 どうしてでしょうか。 教えてください。 1 Sub 寸法線1() 2 Dim l1, l2, l3, l4, lb, la1, la2, fig1, fig2, fig3, fig4 As Shape 3 x1 = 200 4 y1 = 500 5 x2 = x1 + 100 6 k = Cells(7, 5).Value / Cells(7, 4).Value 7 y2 = y1 - 100 * k 8 Set l1 = ActiveSheet.Shapes.AddLine(x1, y1, x2 + 20, y1) 9 Set l2 = ActiveSheet.Shapes.AddLine(x1, y1, x1, y2 - 15) 10 Set lb = ActiveSheet.Shapes.AddLine(x1, y1, x2, y2) lb.Line.Weight = 2# 11 Set l3 = ActiveSheet.Shapes.AddLine(x2 + 5, y2, x2 + 20, y2) 12 Set l4 = ActiveSheet.Shapes.AddLine(x2, y2 - 5, x2, y2 - 15) 13 Set la1 = ActiveSheet.Shapes.AddLine(x2 + 12.5, y1 - 2, x2 + 12.5, y2 + 2) 14 la1.Line.BeginArrowheadStyle = msoArrowheadTriangle 15 la1.Line.BeginArrowheadLength = msoArrowheadLengthMedium 16 la1.Line.BeginArrowheadWidth = msoArrowheadWidthMedium 17 la1.Line.EndArrowheadStyle = msoArrowheadTriangle 18 la1.Line.EndArrowheadLength = msoArrowheadLengthMedium 19 la1.Line.EndArrowheadWidth = msoArrowheadWidthMedium 20 Set la2 = ActiveSheet.Shapes.AddLine(x1 + 2, y2 - 10, x2 - 2, y2 - 10) 21 la2.Line.BeginArrowheadStyle = msoArrowheadTriangle 22 la2.Line.BeginArrowheadLength = msoArrowheadLengthMedium 23 la2.Line.BeginArrowheadWidth = msoArrowheadWidthMedium 24 la2.Line.EndArrowheadStyle = msoArrowheadTriangle 25 la2.Line.EndArrowheadLength = msoArrowheadLengthMedium 26 la2.Line.EndArrowheadWidth = msoArrowheadWidthMedium 27 Set fig1 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ x1 - 10, y1 + 5, 17, 17) 28 fig1.Select 29 Selection.Characters.Text = Str(Cells(6, 3)) 30 Selection.Characters.Font.Bold = True 31 Selection.ShapeRange.Line.Visible = msoFalse 32 Set fig2 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ x2 + 5, y2 - 20, 18, 18) 33 fig2.Select 34 Selection.Characters.Text = Str(Cells(7, 3)) 35 Selection.Characters.Font.Bold = True 36 Selection.ShapeRange.Line.Visible = msoFalse 37 Set fig3 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ x1 + (x2 - x1) * 0.5 - 13, y2 - 32, 45, 17) 38 fig3.Select 39 Selection.Characters.Text = Str(Cells(7, 4)) 40 Selection.ShapeRange.Line.Visible = msoFalse 41 Set fig4 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationUpward, _ x2 + 15, y1 - 0.5 * (y1 - y2) - 8, 17, 45) 42 fig4.Select 43 Selection.Characters.Text = Str(Cells(7, 5)) 44 Selection.ShapeRange.Line.Visible = msoFalse 45 MsgBox "pause" 46 Call l1.Select 47 Call l2.Select(False) 48 Call l3.Select(False) 49 Call l4.Select(False) 50 Call lb.Select(False) 51 Call la1.Select(False) 52 Call la2.Select(False) 53 Call fig1.Select(False) 54 Call fig2.Select(False) 55 Call fig3.Select(False) 56 Call fig4.Select(False) 57 MsgBox "hit any" 58 Selection.ShapeRange.Group.Delete 59 End Sub Cells(7, 5)=50 cells(7,4)=100 cells(6,3)=1 cells(7,3)=2 です。 左端に行番号をふってあります。 36から44まで飛んでしまいます。 節点 座標 X Y 1 0 0 2 100 50
- ベストアンサー
- その他（プログラミング・開発）
- ExcelVBAでオートシェイプラインを変更したい
Excel2013を使用しています。表中の空欄にShapeを使って斜めにラインを引いていますが、この線をデータのカウントに合わせて上端を変化させたい。AddLineにて線を挿入するコードとマクロでのSelection.ShapeRange.ScaleWidth 1.3605442177, msoFalse, msoScaleFromBottomRight 'Selection.ShapeRange.ScaleHeight 0.7500001875, msoFalse, _では希望通りできますが、いちいちポイントをつかまなくてはなりません。名前を付けたラインをセレクトして「I27(右上)～B31(左下固定)」等と上端を変化できる方法を教えてください。
- 締切済み
- Visual Basic
- オートシェイプの位置
エクセルですが。 セレクトされているオートシェイプを所定の位置に配置するマクロとして、以下は動作するのですが。 Selection.ShapeRange.Left = 250 Selection.ShapeRange.Top = 100 名前ボックスからオートシェイプの名前を aaa に変更し、以下のマクロを実行すると、いずれもエラーになってしまいます。 aaa.ShapeRange.Left = 250 aaa.ShapeRange.Top = 100 aaa.Left = 250 aaa.Top = 100 どこが間違っているのでしょうか？
- ベストアンサー
- オフィス系ソフト
お礼
これです！見事にオートシェイプが消えました。ありがとうございます！
補足
実はこれでも充分なんですが、アクティブシートの罫線が全部消えてしまいますよね。私が説明しなかったのが悪いのですが、実は表は１シートに６個あるんです。マクロはそれぞれの表に描写の為に６個あります。消すボタンも６個つけるとして、範囲を指定して消去することは出来るんでしょうか・・。もしこれが出来たら言うことなしです！