- ベストアンサー
エクセルVBAでオートシェープの連番はいくつまで使えますか？
Wendy02の回答
- Wendy02
- ベストアンサー率57% (3570/6232)
KenKen_SP 様 有力な情報ありがとうございました。早速、見させていただきました。
関連するQ&A
- エクセルVBAで芸術的な画面の動き？
このカテを検索していて、以下のような芸術的というか、とても面白いVBAのコードを見つけました。テストしたらエクセルでこんなことが出来るのかと驚きました。 自分ではコードはわかりますが、センスがなくてこういう動きはなかなか思いつきません。 多分他にもいろんなことが出来るのでしょうが、どんな面白いのがありますか？是非教えてください。 Sub test01() Randomize With ActiveSheet .Cells.Interior.ColorIndex = 1 CL = Int((50 * Rnd) + 1) L1 = Int((700 * Rnd) + 20) H1 = Int((450 * Rnd) + 20) Set SA = .Shapes.AddShape(msoShape5pointStar, L1, H1, 25, 25) SA.Name = "Merlion_" & SA.Name SA.Fill.ForeColor.SchemeColor = CL For n = 1 To 100 CL = Int((50 * Rnd) + 1) L2 = Int((600 * Rnd) + 20) H2 = Int((300 * Rnd) + 20) SA.Top = H2 - SA.Width / 2 SA.Left = L2 - SA.Height / 2 SA.Fill.ForeColor.SchemeColor = CL Set SL = .Shapes.AddLine(L1, H1, L2, H2) SL.Name = "Merlion_" & SL.Name Application.StatusBar = SL.Name SL.line.Weight = 0.75 SL.line.ForeColor.SchemeColor = CL L1 = L2 H1 = H2 Next SA.ZOrder msoBringToFront SA.line.Visible = True SA.line.ForeColor.SchemeColor = CL For i = 1 To 800 Step 60 SA.Rotation = i / 10 SA.line.Weight = i DoEvents Next For Each s In .Shapes If s.Name Like "Merlion_*" Then s.Delete Next .Cells.Interior.ColorIndex = xlNone End With End Sub
- 締切済み
- オフィス系ソフト
- エクセルVBAでの複数のオートシェイプの色塗り方法
ネットから下記のコードを見つけたのですが、１つのシートに複数のオートシェイプの色塗りを変更する方法を教えてください。 例えばセル"A1"には数値の1と"A2"には数値2を入力したら、 オートシェイプAにはセル"A1"に対応した色塗り『赤色』を オートシェイプBにはセル"A2"に対応した色塗り『黄色』といった感じです。 下記のコードをいくつも繋げれば、複数のオートシェイプの色塗りが出来ると思ったのですが、コードを繋げる方法がわかりません。その他に何か良い方法がありましたら教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) <> "A1" Then Exit Sub With ActiveSheet.Shapes("ABC").Fill.ForeColor Select Case Target.Value Case Is = "赤" .SchemeColor = 2 Case Is = "黄" .SchemeColor = 5 Case Is = "緑" .SchemeColor = 3 Case Is = "青" .SchemeColor = 4 Case Else .SchemeColor = 1 End Select End With End Sub
- ベストアンサー
- Visual Basic
- エクセルVBAでオートシェープを円く動かしたい。
星型をシート上で回転しながらぐるっと円周のように動かそうと、ためしに下記のマクロを書きましたが、やはり方向転換がぎこちなく、スムーズな丸い動きにはなりません。 かと言って、上下左右以外に動かす方法はないでしょうし、何かいいやり方はないでしょうか？ Sub Star() With ActiveSheet.Shapes.AddShape(msoShape5pointStar, 273#, 43#, 50#, 50#) .Fill.ForeColor.SchemeColor = 13 .Line.Weight = 0.75 .Line.ForeColor.SchemeColor = 64 For i = 1 To 180 a = 1 b = 1 If i > 90 Then a = -1 If i < 45 Or i > 135 Then b = -1 .IncrementRotation 2 .IncrementTop 2 * a .IncrementLeft -2 * b DoEvents Next End With End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBAでLineの一括処理
ワークシート上に配置した複数のオートシェープの線（Lines）に対し、一括して太さと色を変えるにはどのようなコードになるのでしょうか？ 勿論以下のTEST01のように名前で指定すれば可能なのですが、TEST02のような全てのLineということはできないのでしょうか？ Sub Test01() With ActiveSheet.Shapes.Range(Array("Line 259", "Line 260")) .line.Weight = 1.75 .line.ForeColor.SchemeColor = 13 End With End Sub ↓実行時エラーとなる Sub Test02() With ActiveSheet.Lines .line.Weight = 2.5 .line.ForeColor.SchemeColor = 10 End With End Sub
- ベストアンサー
- オフィス系ソフト
- 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製品
- エクセルVBAでShapeRangeについて
すみません、教えてください。 以下のマクロは正常に動きます。 Sub TEST() With ActiveSheet For Each s In .Shapes If s.AutoShapeType = msoShape5pointStar Then s.Delete Next .Cells.Interior.ColorIndex = 1 Set AA = .Shapes.AddShape(msoShape5pointStar, 55, 22, 25#, 25#) AA.Fill.Visible = msoTrue AA.Fill.Solid AA.Fill.ForeColor.SchemeColor = 13 AA.Fill.Transparency = 0# AA.line.Weight = 0.75 AA.line.DashStyle = msoLineSolid AA.line.Style = msoLineSingle AA.line.Transparency = 0# AA.line.Visible = msoTrue AA.line.ForeColor.SchemeColor = 64 ' AA.Copy '(1) ' .Paste '(1) ' Set AB = Selection '(1) ' .Range("A1").Select'(1) Set AB = AA.Duplicate '(2) AB.Top = 44 AB.Left = 110 ' AB.ShapeRange.Fill.ForeColor.SchemeColor = 10'(1)の２ AB.Fill.ForeColor.SchemeColor = 10 '(2)の２ End With End Sub ところが、 Set AB = AA.Duplicate '(2)の部分を、コメントアウトしている '(1)の記述に変えると、 AB.Fill.ForeColor.SchemeColor = 10 '(2)の２ の部分も ' AB.ShapeRange.Fill.ForeColor.SchemeColor = 10'(1)の２ に変えないとエラーになります。 ' AA.Copy '(1) ' .Paste '(1) ' Set AB = Selection '(1) も Set AB = AA.Duplicate '(2) も、同じことのように思えるのですが、この違いで、ShapeRangeというのを入れたり消したりしなければならないのはどうしてでしょうか？ エクセルは2000です。
- ベストアンサー
- オフィス系ソフト
- 特定の名前のオートシェイプの有無を知りたい（エクセルVBA）
Excel VBA で、オートシェイプを扱おうとしています。 たとえば、 ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 50, 50).Name = "TestShape1" のようにして、それぞれ名前を付けているのですが、プログラム中、特定のオートシェイプを削除したり、再び同じ名前で作ったり、ということを行っています。 前者の場合、すでに当該オートシェイプが削除されている場合、目的のオートシェイプが存在していないためか、エラーが発生します。また後者の場合も、オートシェイプを重ねて作成することになってしまうケースにエラーが発生します。 On Error Resume Next で回避することも考えられるでしょうが、もっと直接的に、ある名前のオートシェイプが存在する／しない、をチェックしたうえで各処理を行うようにしたいのです。 どのような方法があるでしょうか？
- ベストアンサー
- オフィス系ソフト
- 挿入したオートシェイプが文字入力待機状態にする方法
昨日HohoPapaさんに選択したセルとピッタリ合うオートシェイプの挿入の仕方を教えていただきました。 今度は、オートシェイプがアクティブ状態とでもいうのでしょうか、挿入後すぐにタイプしたら文字が入力できる状態にする方法を教えていただきたいです。フォントのサイズ、位置は不問で黒色で入力できればと思います。 よろしくお願いいたします。 Set shrect = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ Selection.Left, Selection.Top, Selection.Width, _ Selection.Height) shrect.Fill.ForeColor.SchemeColor = 22 'Grey 'shrect.Font.Color = vbBlack ←うまくいかなかった部分
- ベストアンサー
- Visual Basic
- エクセルで、最背面に移動と塗りつぶしなし
先ほど、最背面に移動を Dim sp As Shape Set sp = ActiveSheet.Shapes.AddShape(msoShapeOval, 340, 140, 73, 52) With sp With .Line .Weight = xlThin .ForeColor.SchemeColor = 10 End With .ZOrder msoSendToBack End With の様に教えていただきました。しかし、併せてオートシェイプの書式設定で塗りつぶしの色の「塗りつぶしなし」を設定したいのです。 自動記録に試して見ましたが,エラーが出て上手くいきません。よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルＶＢＡのＷｉｔｈ～End With構文
Win2000エクセル2000です。 下記のMacro11はTEST11のようにWith～End Withでくくれると思うのですがエラーになります。 どこがおかしいのでしょうか？ Sub Macro11() ActiveSheet.Shapes.AddShape(msoShapeSun, 450, 150, 120, 120).Select Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.ForeColor.SchemeColor = 64 Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10 Selection.ShapeRange.Fill.OneColorGradient msoGradientFromCorner, 1, 0.59 Selection.ShapeRange.Adjustments.Item(1) = 0.3016 Selection.ShapeRange.ThreeD.SetThreeDFormat msoThreeD7 Selection.ShapeRange.ThreeD.PresetMaterial = msoMaterialMetal Selection.ShapeRange.ThreeD.Depth = 144# End Sub Sub TEST11() With ActiveSheet.Shapes.AddShape(msoShapeSun, 450, 150, 120, 120) .ShapeRange.Line.Weight = 0.75 .ShapeRange.Line.ForeColor.SchemeColor = 64 .ShapeRange.Fill.ForeColor.SchemeColor = 10 .ShapeRange.Fill.OneColorGradient msoGradientFromCorner, 1, 0.59 .ShapeRange.Adjustments.Item(1) = 0.3016 .ShapeRange.ThreeD.SetThreeDFormat msoThreeD7 .ShapeRange.ThreeD.PresetMaterial = msoMaterialMetal .ShapeRange.ThreeD.Depth = 144# End With End Sub
- ベストアンサー
- オフィス系ソフト